Hilfe für Vergleichen - einfügen

Bild

Betrifft: Hilfe für Vergleichen - einfügen
von: Peter
Geschrieben am: 12.06.2015 09:17:37

Guten Morgen
ich benötige wieder einmal die Hilfe der Fachleute.
Ich habe eine Excel-Datei mit vier Tabellen. In der 1. sind alle Codes vorhanden.
In der 2. bestimmte ausgewählte Codes. Nun sollen die Codes, die in diesen beiden
Tabellen vorhanden sind und in Anzahl Wert vorhanden ist mit Code und Anzahl der Reihe nach in die Tabelle 3 eingefügt werden. Die aus der Tabelle 2, die nicht mit der Tabelle 1 identisch sind und die keinen Wert bei Anzahl aufweisen, sollen
in die Tabelle 4 eingefügt werden.
Besten Dank für Eure Hilfe.
Noch ein Hinweis: Die Tabellen 1 und 2 sind unterschiedlich lang, je nachdem, was
eingespielt wird.
https://www.herber.de/bbs/user/98159.xlsm
Gruss
Peter

Bild

Betrifft: AW: Hilfe für Vergleichen - einfügen
von: Sepp
Geschrieben am: 12.06.2015 20:31:27
Hallo Peter,
per VBA.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub compare()
  Dim varAll As Variant, varChoosen As Variant, varError() As Variant, varIdentic() As Variant
  Dim lngN As Long, lngI As Long, lngE As Long
  Dim vntR As Variant
  
  With Sheets("Tabelle1_alle")
    varAll = .Range("A2:A" & Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row))
  End With
  
  With Sheets("Tabelle2_gewählte")
    varChoosen = .Range("A2:B" & Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row))
  End With
  
  Sheets("Tabelle4_Fehler").Range("A2:B1000") = ""
  Sheets("Tabelle3_identisch").Range("A2:B1000") = ""
  
  
  For lngN = 1 To UBound(varChoosen, 1)
    If varChoosen(lngN, 1) <> "" Then
      vntR = Application.Match(varChoosen(lngN, 1), varAll, 0)
      If IsError(vntR) Or varChoosen(lngN, 2) = "" Then
        Redim Preserve varError(lngE)
        varError(lngE) = Array(varChoosen(lngN, 1), varChoosen(lngN, 2))
        lngE = lngE + 1
      End If
      If Not IsError(vntR) And varChoosen(lngN, 2) <> "" Then
        Redim Preserve varIdentic(lngI)
        varIdentic(lngI) = Array(varChoosen(lngN, 1), varChoosen(lngN, 2))
        lngI = lngI + 1
      End If
    End If
  Next
  
  If lngI > 0 Then _
    Sheets("Tabelle4_Fehler").Range("A2").Resize(UBound(varError) + 1, 2) = _
    Application.Transpose(Application.Transpose(varError))
  
  If lngE > 0 Then _
    Sheets("Tabelle3_identisch").Range("A2").Resize(UBound(varIdentic, 1) + 1, 2) = _
    Application.Transpose(Application.Transpose(varIdentic))
  
  
End Sub


Gruß Sepp


Bild

Betrifft: AW: Hilfe für Vergleichen - einfügen
von: Peter
Geschrieben am: 13.06.2015 13:03:30
Hallo Sepp,
besten Dank für Deine schnelle und vorallem funktionierende Hilfe.
Habe Makro gerade ausprobiert funktioniert bestens.
Wünsche ein schönes Wochenende.
Gruss Peter

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Hilfe für Vergleichen - einfügen"