Registriert seit: 12.10.2014
Version(en): 365 Insider (64 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 2024 / 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, 17:22
(Dieser Beitrag wurde zuletzt bearbeitet: 14.06.2017, 17: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, 15: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, 19:29
(Dieser Beitrag wurde zuletzt bearbeitet: 14.06.2017, 19:31 von Kuwer.)
(14.06.2017, 17: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 2024 / Arbeit: MS365
14.06.2017, 20:22
(Dieser Beitrag wurde zuletzt bearbeitet: 14.06.2017, 20:27 von cysu11.)
(14.06.2017, 18: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 2024 / Arbeit: MS365
(14.06.2017, 19: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, 20: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 2024 / Arbeit: MS365
Hallo Uwe,  danke für die Hilfe und für die Erklärung! :) Viele Grüße Alexandra
|