Re: 2.Versuch-Tabellenabgleich mit einer Vorlage
22.07.2002 13:40:40
oliver
Hi,das erste Mekro löscht "unrelevante" Zellen, mußt du halt noch anpassen.
weiter unten folget der Abgleich der Daten. x-tra makro.
last = Range("A65536").End(xlUp).Row
zählwert = 1
For zeile = 1 To last
wert = ThisWorkbook.Sheets(1).Cells(zeile, 1).Value
wert2 = ThisWorkbook.Sheets(1).Cells(zeile, 2).Value
' kriterien wann eine zeile gelöscht werden soll. wert2= kriterien in Spalte b, wert= kriterien
' in spalte a
If Left(wert2, 5) = "Summe" Or wert = "Aachen" Then
zählwert = -1
ThisWorkbook.Sheets(1).Rows(zeile).Select
Selection.Delete
zeile = zeile - 1
Else
If wert = "T-Systems" Or Left(wert, 5) = "Summe" Or Left(wert, 5) = "Buchu" Or Left(wert, 5) = "Auftr" Or wert = "eig." Or wert = "Son." Or Left(wert, 5) = "Numme" Or wert = "----------" Or wert = "F&G" Or Left(wert, 4) = "0025" Or Left(wert, 4) = "Ausb" Or wert = "x" Or wert = "56000000" Or wert = "56050000" Or wert = "56060000" Or wert = "57105600" Or wert = "14000015" Or wert = "57105600" Or wert = "98000000" Or wert = "57105606" Or wert = "57105605" Then
zählwert = 1
ThisWorkbook.Sheets(1).Rows(zeile).Select
Selection.Delete
zeile = zeile - 1
' Else
' If wert = "" And zählwert < 50 Then
' ThisWorkbook.Sheets(1).Rows(zeile).Select
' Selection.Delete
' zählwert = zählwert + 1
' zeile = zeile - 1
'Else
zählwert = 1
End If
End If
'End If
Next
Hier werden die Übereinstimmungen überprüft
Sub HGB3()
'
' HGB3 Makro
' Makro am 18.04.2002 von Oliver Fuchs aufgezeichnet
'' vergleicht Spalte A in Tabelle 2 (HGB) mit Spalte A in Tabelle 1 (ZKPCSLI6)
' und kennzeichnet übereinstimmende Werte in Tabelle 1 mit "OK"
' es wird jeweils EIN aktueller Wert mit der GESAMTEN Spalte verglichen und nicht
' zum Beispiel HGB A1 mit ZKPCSLI6 A1
' dim definiert wieveile zeilen überprüft werden sollen
' verg1 und vrg2 sind die auftragsnummern
' bei übereinstimmung werden diese mit "OK" gekennzeichnet
Dim verg1(500)
Dim verg2(500)
Worksheets(2).Activate
z = 1
Do While Cells(z, 1) <> ""
verg1(z) = Cells(z, 1)
z = z + 1
Loop
Worksheets(1).Activate
zz = 1
Do While Cells(zz, 1) <> ""
verg2(zz) = Cells(zz, 1)
zz = zz + 1
Loop
For r = 1 To zz
For s = 1 To z
If verg1(s) = verg2(r) Then Cells(r, 2) = "OK"
Next s
Next r
End Sub