Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Zusatzfrage zu VBA vergleich mehrere Tab

Betrifft: Zusatzfrage zu VBA vergleich mehrere Tab von: Martin
Geschrieben am: 16.03.2020 14:36:29

Ausgangslage:

Hallo zusammen,

ich stehe vor einem Problem.

bin dran an einer Datei mit zwei Tabellenblätter. (Tabelle 1 und Tabelle 2)


Ich möchte bei Tabelle 1, Spalte A einen Wert eingeben und dieser sollte

dann in Tabelle 2 Spalte A gesucht werden. (Gleich nach der Eingabe des Wertes, mit Enter bestätigt)

Bei Übereinstimmung soll die Zeile kopiert werden

und in Tabelle 1 beim gesuchten Wert ab Spalte B (nach rechts) eingefügt werden.

(Ja mit Sverweis könnte es auch funktionieren sind aber zuviele Datenabfragen)


Die Tabelle 1, Spalte A, können unterschiedliche Anzahl Zeilenwerte haben. (einmal sollen 3 Werte abgefragt werden und dann wieder 5 Werte)


folgenden VBA- Code habe ich bereits:

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Fehler
    Dim Tb2 As Worksheet, ZE As Integer, Z
    Const APPNAME = "Worksheet_Change"

    Set Tb2 = Sheets("Tabelle2")
    ZE = 4 ' Erste Datenzeile 

    If Not Intersect(Range("A:A"), Target) Is Nothing Then
        If Target.Row >= ZE Then
            For Each Z In Intersect(Range("A:A"), Target)
                With Z.Offset(0, 1).Resize(1, 3)
                    Application.EnableEvents = False
                    .FormulaR1C1 = "=IFERROR(VLOOKUP(RC1," & Tb2.Name & "!C1:C4,COLUMN(),0),"""" _
 _
)"
                    .Value = .Value
                    Application.EnableEvents = True
                End With
            Next
        End If
    End If

    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

zusätzliche Frage:

Welchen Wert muss ich ändern wenn in Tabelle2 weitere Spalten dazukommen?


Ist es möglich eine Abfrage zu starten, wenn in Tabelle1 Zelle M1 den Wert "Morgen" hat dann die

Suche auf das Tabellenblatt "Morgen" zu beziehen?

Und wenn in Tabelle1 Zelle M1 den Wert "Abend" hat dann die Suche auf das Tabellenblatt "Abend" zu beziehen?

Betrifft: AW: Zusatzfrage zu VBA vergleich mehrere Tab
von: Lutz Fricke
Geschrieben am: 16.03.2020 15:42:42

Hallo Martin,

diesen 3'er in die maximale Anzahl an Spalten ändern:
With Z.Offset(0, 1).Resize(1, 3)

Zur geänderten Abfrage die Zeile
Set Tb2 = Sheets("Tabelle2")
löschen und nach
If Not Intersect(Range("A:A"), Target) Is Nothing Then
folgendes einfügen:
If cells(1, 13)="Morgen" then
Set Tb2 = Sheets("Morgen")
Elseif cells(1, 13)="Abend" then
Set Tb2 = Sheets("Abend")
Else
Set Tb2 = Sheets("Tabelle2")
End if

Code ist ungetestet.

Gruß,
Lutz

Betrifft: AW: Zusatzfrage zu VBA vergleich mehrere Tab
von: UweD
Geschrieben am: 16.03.2020 15:49:57

Hallo

zu 1)
>>Welchen Wert muss ich ändern wenn in Tabelle2 weitere Spalten dazukommen?
 With Z.Offset(0, 1).Resize(1, 3)
die 3 in Resize gibt an, wieviele Spalten mit der Formel versehen werden.


zu 2)
>>Morgen /Abend


beim Ändern der Zelle M1 müssten dann alle Verweise geändert werden.
Das wäre dann genauso Rechenintensiv, als ob du die Sverweisformel direkt in den Zellen stehen lässt.


Wenn nur NEUE Änderungen in Spalte A berücksichtigt werden sollen, dann wäre das so möglich.


Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Tb2 As String, ZE As Integer, Z
    Const APPNAME = "Worksheet_Change"

    On Error GoTo Fehler
    Tb2 = Sheets("Tabelle1").Range("M1")
    ZE = 4 ' Erste Datenzeile 

    If Not Intersect(Range("A:A"), Target) Is Nothing Then
        If Target.Row >= ZE Then
            For Each Z In Intersect(Range("A:A"), Target)
                With Z.Offset(0, 1).Resize(1, 3)
                    Application.EnableEvents = False
                    .FormulaR1C1 = "=IFERROR(VLOOKUP(RC1," & Tb2 & "!C1:C4,COLUMN(),0),"""")"
                    .Value = .Value
                    Application.EnableEvents = True
                End With
            Next
        End If
    End If

    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub
LG UweD

Betrifft: AW: Zusatzfrage zu VBA vergleich mehrere Tab
von: Martin
Geschrieben am: 17.03.2020 10:52:42

Hallo Uwe,
zu 1:
With Z.Offset(0, 1).Resize(1, 3)
- ich habe den Wert von 3 auf 8 geändert
With Z.Offset(0, 1).Resize(1, 8)
- leider zieht es mir die Daten von 4-8 nicht.
was mache ich falsch?

zu 2:
Habe dein angepassten Code genommen und funktioniert einwandfrei und so war die Idee mit
nur NEUE Änderungen in Spalte A berücksichtigt werden sollten.

Bitte um nochmalige Hilfe zu 1:

Vielen Dank.

Betrifft: AW: Zusatzfrage zu VBA vergleich mehrere Tab
von: UweD
Geschrieben am: 17.03.2020 12:07:13

Hallo

ok, der Bereich in der Formel muss auch noch erweitert werden.

Ich hab das makro so geändert, dass die Letzte Spalte in Zeile 4 ermittelt wird, und Diese wird dann verwendet.


Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Tb2 As String, ZE As Integer, Z, Sp As Integer
    Const APPNAME = "Worksheet_Change"

    On Error GoTo Fehler
    Tb2 = Sheets("Tabelle1").Range("M1")
    ZE = 4 ' Erste Datenzeile 
    
    If Not Intersect(Range("A:A"), Target) Is Nothing Then
        If Target.Row >= ZE Then
            
            'Spaltenzahl ermitteln 
            With Sheets(Tb2)
                Sp = .Cells(ZE, .Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile 
            End With
            
            
            For Each Z In Intersect(Range("A:A"), Target)
                With Z.Offset(0, 1).Resize(1, Sp - 1)
                    Application.EnableEvents = False
                    .FormulaR1C1 = "=IFERROR(VLOOKUP(RC1," & Tb2 & "!C1:C" & Sp & ",COLUMN(),0),"""")"
                    .Value = .Value
                    Application.EnableEvents = True
                End With
            Next
        End If
    End If

    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD

Betrifft: AW: Zusatzfrage zu VBA vergleich mehrere Tab
von: Martin
Geschrieben am: 17.03.2020 12:14:44

Vielen Lieben Dank für deine schnelle und perfekte Lösungen/Antworten!

Beiträge aus dem Excel-Forum zum Thema "Zusatzfrage zu VBA vergleich mehrere Tab"