Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1428to1432
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Hilfe für Vergleichen - einfügen

Hilfe für Vergleichen - einfügen
12.06.2015 09:17:37
Peter
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hilfe für Vergleichen - einfügen
12.06.2015 20:31:27
Sepp
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

Anzeige
AW: Hilfe für Vergleichen - einfügen
13.06.2015 13:03:30
Peter
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige