On Error - "Befehl"
18.07.2003 07:01:56
Erich M.
ich suche eine Lösung mit On Error (glaube ich) bei folgendem Makro:
- das Makro erstellt immer eine neue Tabelle "Fehlende"
- wenn das Makro das zweite mal läuft, sollte deshalb zuerst die Tabelle "Fehlende" gelöscht sein
- wenn die Tabelle "Fehlende" vorher manuell gelöscht wurde und das makro die Tabelle nicht findet gibts natürlich eine Fehlermeldung
Wie kann ich das Problem beheben - ich habe im Makro an der vermeintlichen Stelle "On Error" eingefügt, aber die richtige Lösung habe ich noch nicht gefunden:
Sub Tabellenvergleich()
' vergleicht zwei Tabellen und schreibt Werte, die nicht
' in beiden Tabellen vorkommen, in eine dritte Tabelle
' postmaster@klaus-dieter-2000.de
Dim verg1(3000), verg2(3000), merk1(3000), merk2(3000) ' Feldvariablen dimensionieren
Dim myName1 As String, myName2 As String, myName3 As String
Dim Spalte1 As Integer, Spalte2 As Integer, Spalte3 As Integer, Spalte4 As Integer
Dim z As Integer, y As Integer, r As Integer, s As Integer, t As Integer
Dim tt As Integer, v As Integer, vv As Integer
Sheets("Fehlende").Activate
'On Error GoTo ??
Sheets("Fehlende").Delete
' Werte aus Tabelle 1 einlesen
myName1 = InputBox("Erste Tabelle")
Sheets(myName1).Activate
Spalte1 = InputBox("Vergleichsspalte")
'Worksheets("tab1").Activate ' 1. Tabelle aktivieren
z = 1 ' Schleifenzähler auf Startwert (Zeile 1)
Do While Cells(z, Spalte1) <> "" ' Start der Schleife zum Einlesen der Werte
verg1(z) = Cells(z, Spalte1) ' Vergleichswert einlesen
z = z + 1 ' Schleifenzähler um 1 erhöhen
Loop ' Wendepunkt für Schleife
' Werte aus Tabelle 2 einlesen
myName2 = InputBox("Zweite Tabelle")
Sheets(myName2).Activate
Spalte2 = InputBox("Vergleichsspalte")
'Worksheets("tab2").Activate ' Tabelle 2 aktivieren
y = 1 ' Wie oben
Do While Cells(y, Spalte2) <> "" ' "
verg2(y) = Cells(y, Spalte2) ' "
y = y + 1 ' "
Loop ' "
' Werte vergleichen
For r = 1 To z - 1 ' Start "äußere" For To Next Schleife
For s = 1 To y - 1 ' Start "innere" For To Next Schleife
' Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja" ' Wenn Vergleichswerte gleich, Merker setzen
If verg2(s) = verg1(r) Then merk2(s) = "ja" ' Wenn Vergleichswerte gleich, Merker setzen
Next s ' Wendepunkt "innere" For To Next Schleife
Next r ' Wendepunkt "äußere" For To Next Schleife
Sheets.Add.Name = "Fehlende"
Worksheets("Fehlende").Activate ' Tabelle 3 aktivieren
' Ungleiche Werte aus Tabelle 1 ausgeben
Cells(1, 1) = "Wert fehlt in" & Chr(10) & "Tabelle " & myName2 _
& Chr(10) & "Spalte " & Spalte2
For t = 1 To r ' Start For To Next Schleife
If merk1(t) <> "ja" Then ' Wenn Merker = "ja" dann
tt = tt + 1 ' > Zeilenzähler um 1 erhöhen
Cells(tt + 1, 1) = verg1(t) ' > Vergleichswert in Tabelle schreiben
End If ' Ende Wenn-Bedingung
Next t ' Wendepunkt For To Next Schleife
' Ungleiche Werte aus Tabelle 2 ausgeben
Cells(1, 2) = "Wert fehlt in" & Chr(10) & "Tabelle " & myName1 _
& Chr(10) & "Spalte " & Spalte1
For v = 1 To s ' wie oben
If merk2(v) <> "ja" Then ' "
vv = vv + 1 ' "
Cells(vv + 1, 2) = verg2(v) ' "
End If ' "
Next v ' "
Sheets("Fehlende").Activate
Range("C1").Select
End Sub
Code eingefügt mit: Excel Code Jeanie
Besten Dank für eine Hilfe!
mfg
Erich