Mein algorithmus funktioniert nicht!!
18.06.2004 11:05:10
Sebastian
ich habe auf 3 Sheets je 1 sehr lange Tabelle, dabei soll die erste Tabelle mit den beiden anderen aktualisiert werden. Sobald der gleiche Artikel gefunden wurde (Sheet 1 Spalte B, Sheet 2 und 3 Spalte C), soll der Preis aus der gleichen Zeile (Sheet 2 und 3 Spalte F) in die 1. Tabelle übernommen werden (Spalte F). Dann soll auch gleich mit dem nächsten Artikel in der 1. Tabelle weitergemacht werden. Ich habe dazu einen Algorithmus aufgestellt und einprogrammiert. Ich habe vorher extra die Anwendung jedes einzelnen Bestandteils ausprobiert und alles lief so, wie es sollte. Nur als ich dann den kompletten Algorithmus geschrieben habe, hat es nicht funktioniert. Ich find einfach nicht den Fehler, vielleicht kann mir ja einer von euch helfen....
Hier mein Algorithmus:
Sub Preisabgleich()
Dim ing, pr1, pr2 As Worksheet
Set ing = Worksheets("DB_HW_Ingredients")
Set pr1 = Worksheets("pricing1")
Set pr2 = Worksheets("pricing2")
Dim i, j, k As Long 'Zähler für die Zeilen in den Sheets 1,2 und 3
Dim found As Boolean
For i = 6 To 7 'eigentlich bis 1184
found = False
If ing.Cells(i, 2).Value <> "" Then
For j = 7 To 45026
If ing.Cells(i, 2).Value = pr1.Cells(j, 3).Value Then
ing.Cells(i, 6).Value = pr1.Cells(j, 6).Value 'Preis kopieren
ing.Cells(i, 6).Select
With Selection.Interior 'farbig markieren zur Kontrolle
.ColorIndex = 4
.Pattern = xlSolid
End With
found = True
Exit For 'Abbruch, da Erfolg
End If
Next
If found = False Then 'Wenn in Tabelle 1 nichts gefunden
For k = 8 To 40613
If ing.Cells(i, 2).Value = pr2.Cells(k, 3).Value Then
ing.Cells(i, 6).Value = pr2.Cells(k, 6).Value 'Preis kopieren
ing.Cells(i, 6).Select
With Selection.Interior 'farbig markieren zur Kontrolle
.ColorIndex = 4
.Pattern = xlSolid
End With
Exit For 'Abbruch, da Erfolg
End If
Next
End If
End If
Next
End Sub