ich will einen Wert aus einer Tabelle (sheet1) mit dem Wert der anderen Tabelle (sheet2) vergleichen. Wenn der Wert 15% kleiner oder groesser ist, dann soll der Wert aus Sheet1 in eine andere Zelle in Sheet1 kopiert werden. Falls der Wert 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?
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