Registriert seit: 12.10.2014
Version(en): 365 Insider (32 Bit)
- Bereich markieren
- Format
- Ausrichtung
- Horizontal
- Über Auswahl zentrieren
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
Hallo Ralf,
das funktioniert zwar, der Inhalt wird horizontal verteilt über alle Zellen gezeigt, allerdings ist jetzt mein Dropdown(Datenüberprüfung) mitten zwischen den Zellen ::(
Gibt es noch andere Ideen?
Vielen Dank
VG
Alexandra
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Alexandra,
so geht es bei mir auch mit Entfernen: Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
If Target.Cells(1).MergeArea.Address = "$A$18:$F$18" Then
Set Bereich = Tabelle4.Range("A2:E3")
On Error Resume Next
Application.EnableEvents = False
Me.Cells(19, 1).Value = Application.VLookup(Target.Value, Bereich, 2, False)
If Application.IsNA(Me.Cells(19, 1).Value) Then
Me.Cells(19, 1) = ""
Me.Cells(20, 1) = ""
Me.Cells(22, 1) = ""
Me.Cells(27, 1) = ""
Else
Me.Cells(20, 1).Value = Application.VLookup(Target.Value, Bereich, 3, False)
Me.Cells(22, 1).Value = Application.VLookup(Target.Value, Bereich, 4, False) & " " & Application.VLookup(Target.Value, Bereich, 5, False)
'Me.Cells(23, 1).Value = Application.VLookup(Target.Value, Bereich, 5, False)
Me.Cells(27, 1).Value = Application.VLookup(Target.Value, Bereich, 5, False)
End If
Application.EnableEvents = True
On Error GoTo 0
End If
End Sub Gruß Uwe
Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:1 Nutzer sagt Danke an Kuwer für diesen Beitrag 28
• cysu11
Registriert seit: 29.09.2015
Version(en): 2030,5
14.06.2017, 16:22
(Dieser Beitrag wurde zuletzt bearbeitet: 14.06.2017, 16:23 von snb.)
Warum keine Beispieldatei hochgeladen ?
Du brauchst 'merged cells' gar nicht, vermute ich.
Und vlookup in VBA ????
Registriert seit: 14.04.2014
Version(en): 2003, 2007
(14.06.2017, 14:56)cysu11 schrieb: Hallo Uwe und Hallo Atilla,
nun habe ich nach langer Probiererei endlich die Ursache gefunden :), aber noch keine Lösung.
Das Zelle A18 ist eine verbundene Zelle bis Spalte F. Wenn ich die Verbindung aufhebe dann klappt es wunderbar aber wenn ich die Zellen wieder verbinde, dann geht es
Hallo Alexandra,
dann hast Du meinen Vorschlag nicht getestet, denn der arbeitet auch bei verbundenen Zellen.
Meinen Variante würde ich um eine MasgBox erweitern:
Code: If Target.CountLarge = 1 Then
If Target.Address(0, 0) = "A18" Then
On Error GoTo fehler
Application.EnableEvents = False
Range("A19:A22") = ""
Range("A27") = ""
x = Application.Match(Target, namensBereich, 0)
If IsNumeric(x) Then
With Tabelle4
Cells(19, 1) = .Cells(x + 1, 2)
Cells(20, 1) = .Cells(x + 1, 3)
Cells(22, 1) = .Cells(x + 1, 4) & " " & .Cells(x + 1, 5)
Cells(27, 1) = .Cells(x + 1, 5)
End With
Else
MsgBox "Dieser Name existoiert nicht in der Namensliste!"
End If
End If
End If
fehler:
Application.EnableEvents = True
If Err Then MsgBox "Fehler: " & Err.Number & vbLf & vbLf & Err.Description
End Sub
Gruß Atilla
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
14.06.2017, 18:29
(Dieser Beitrag wurde zuletzt bearbeitet: 14.06.2017, 18:31 von Kuwer.)
(14.06.2017, 16:22)snb schrieb: Du brauchst 'merged cells' gar nicht, vermute ich.
Richtig, so geht es z.B. auch: If Target.Cells(1).Address = "$A$18" Then
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
14.06.2017, 19:22
(Dieser Beitrag wurde zuletzt bearbeitet: 14.06.2017, 19:27 von cysu11.)
(14.06.2017, 17:58)atilla schrieb: Hallo Alexandra,
dann hast Du meinen Vorschlag nicht getestet, denn der arbeitet auch bei verbundenen Zellen.
Meinen Variante würde ich um eine MasgBox erweitern:
Code: If Target.CountLarge = 1 Then
If Target.Address(0, 0) = "A18" Then
On Error GoTo fehler
Application.EnableEvents = False
Range("A19:A22") = ""
Range("A27") = ""
x = Application.Match(Target, namensBereich, 0)
If IsNumeric(x) Then
With Tabelle4
Cells(19, 1) = .Cells(x + 1, 2)
Cells(20, 1) = .Cells(x + 1, 3)
Cells(22, 1) = .Cells(x + 1, 4) & " " & .Cells(x + 1, 5)
Cells(27, 1) = .Cells(x + 1, 5)
End With
Else
MsgBox "Dieser Name existoiert nicht in der Namensliste!"
End If
End If
End If
fehler:
Application.EnableEvents = True
If Err Then MsgBox "Fehler: " & Err.Number & vbLf & vbLf & Err.Description
End Sub
Hallo Atilla,
selbstverständlich habe ich auch dein Vorschlag getestet mit dem gleichen Ergebniss, aber siehe selbst! :)
[ Dateiupload bitte im Forum! So geht es: Klick mich!]
Vielen Dank
VG
Alexandra
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
(14.06.2017, 18:29)Kuwer schrieb: Richtig, so geht es z.B. auch: If Target.Cells(1).Address = "$A$18" Then
Hlalo Uwe,
nun funktioniert es, woran hat es gelegen? :)
Vielen Dank
VG
Alexandra
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Alexandra,
(14.06.2017, 19:32)cysu11 schrieb: nun funktioniert es, woran hat es gelegen? :)
weil ein Zellverbund eine andere Adresse (zumindest beim Leeren) zurückgibt. Fragt man aber die erste Zelle ( .Cells(1) ) ab, ist die Adresse immer gleich, egal ob es sich um einen Zellverbund oder nur eine Zelle handelt.
Gruß Uwe
Registriert seit: 27.04.2014
Version(en): Privat: Office Home & Business 2019 / Arbeit: MS365
Hallo Uwe,
danke für die Hilfe und für die Erklärung! :)
Viele Grüße
Alexandra
|