Hallo Leute,
ich will eine Bestellnummer aus einer Tabelle (sheet1) mit der Bestellnummer der anderen Tabelle (sheet2) vergleichen. Wenn es eine Uebereinstimmung gibt, dann soll der Preis verglichen werden. Wenn der Preis 15% kleiner oder groesser ist, dann soll der Preis aus Sheet1 in eine andere Zelle in Sheet1 kopiert werden. Falls der Preis nicht in diesem Bereich liegt, soll die Differenz dieser Werte in eine andere Zelle im sheet1 gebildet werden. Kann mir jemand bei dem VBA Code helfen?
Mit einer Formel laesst sich das Ganze leider nicht leosen. Es muss naemlich noch in ein anderes Tool integriert werden. Falls Ihr jedoch denkt, dass es eine Formel gibt, dann schickt sie mir, lasst aber die Frage als unbeantwortet.
Hoffentlich war die Frage einigermassen klar, falls es Probleme gibt nicht Frage als beantortet anklicken. Vielleicht kann jemand anderes etwas damit anfangen.
Mein bisheriger Code:
With Worksheets("sheet1")
For lngRow = 2 To Worksheets("Sheet2").Cells(.Rows.Count, 1).End(xlUp).Row
If Trim$(Worksheets("Sheet2").Cells(lngRow, 1).Text) "" And _
Trim$(Worksheets("Sheet2").Cells(lngRow, 2).Text) "" Then
Worksheets("Sheet2").Select
Set objCell = Worksheets("Sheet2").Columns(1). _
Find(What:=.Cells(lngRow, 1).Text, _
LookIn:=xlFormulas, LookAt:=xlWhole)
If ObjPtr(objCell) 0 Then
strAddress = objCell.Address
Do
If Worksheets("Sheet2").Cells(objCell.Row, 2).Text >= _
0.85 * Worksheets("Sheet1").Cells(lngRow, 2).Text Or _
Worksheets("Sheet2").Cells(objCell.Row, 2).Text 1.15 * Worksheets("Sheet1").Cells(lngRow, 2).Text _
Then Worksheets("Sheet1").Cells(lngRow, 2).Text.Copy
Worksheets("Sheet1").Cells(lngRow, 4).Text.Paste
Set objCell = Worksheets("Sheet2").Columns(1). _
FindNext(objCell)
Loop While ObjPtr(objCell) 0 And _
objCell.Address strAddress
End If
End If
Next
End With
Danke
Gnilk