Verbessterte Makro anpassen
mehmet
das folgende Makro soll erweitert werden - ein herzlichen Dank noch mal an Franc:
Sub Uebertragen_Apfel_neu()
Set c = Range("W:W").Find("Apfel", LookIn:=xlValues)
If Not c Is Nothing Then
If Cells(c.Row, 4) = "3HBK1" And Cells(c.Row, 5) = "3HBK2" Then
For i = c.Row + 1 To Cells(65000, 23).End(xlUp).Row
If Cells(i, 23) "" And IsNumeric(Cells(i, 23)) = True Then
Cells(i, 4) = Cells(i, 4) + WorksheetFunction.RoundUp(Cells(i, 23) / 2, 0)
Cells(i, 5) = Cells(i, 5) + WorksheetFunction.RoundDown(Cells(i, 23) / 2, 0)
If Cells(i, 5) = "0" Then Cells(i, 5) = ""
End If
Next
Else
MsgBox """3HBK1"" und/oder ""3HBK2"" nicht gefunden."
End If
Else
MsgBox """Apfel"" wurde nicht gefunden."
End If
End Sub
Meine Erweiterung sollte jetzt von 2 auf 6 Spalten sein:
Sub Uebertragen_Any_Meal()
Set c = Range("ah:ah").Find("Any Meal", LookIn:=xlValues)
If Not c Is Nothing Then
If Cells(c.Row, 6) = "3HM1" And Cells(c.Row, 7) = "3HM2" Then
For i = c.Row + 1 To Cells(65000, 34).End(xlUp).Row
If Cells(i, 34) "" And IsNumeric(Cells(i, 34)) = True Then
Cells(i, 6) = Cells(i, 6).Formula = "=" & Cells(i, 34).Value / 6
Cells(i, 7) = Cells(i, 7).Formula = "=" & Cells(i, 34).Value / 6
Cells(i, 8) = Cells(i, 8).Formula = "=" & Cells(i, 34).Value / 6
Cells(i, 9) = Cells(i, 9).Formula = "=" & Cells(i, 34).Value / 6
Cells(i, 10) = Cells(i, 10).Formula = "=" & Cells(i, 34).Value / 6
Cells(i, 11) = Cells(i, 11).Formula = "=" & Cells(i, 34).Value / 6
If Cells(i, 5) = "0" Then Cells(i, 5) = "" 'wofür steht das
End If
Next
Else
MsgBox """3HM1"" und/oder ""3HM2"" nicht gefunden."
End If
Else
MsgBox """Any Meal"" wurde nicht gefunden."
End If
End Sub
Leider kriege ich es nicht hin bzw. bekomme eine Fehlermeldung
Ferner sollte in den Lösungszellen die vorheriege Zahl stehen, und wenn
eine Zahl hinzukommt, soll man es nachvoll ziehen können, z.B.:
vorher Stand 2, hinzu kommt 1, dann soll in der Zelle "=2+1" mit Value 3 stehen.
Dank im Voraus
Gruss
https://www.herber.de/bbs/user/80938.xls