AW: ungleiches wert finden und MsgBox zeigen
16.05.2017 18:33:26
Zoi
Ok, vielen Dank noch Mal, das funktioniert, was ist wenn dann mehrere If Funktionen sind? Ich probiere und die funktionieren nur separat , nicht alle auf einmal. Entwider eine geht andere nicht.
Andere Vorschlag, bis jetzt sieht so aus:
Sub TEST2()
Dim S, rngZelle As Range
Dim CE As String
Dim AC As String
Dim BC As String
Dim i, SRow, SLastRowBeforeNextS As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Default").Range("D:D")
Set S = .find("S", LookIn:=xlValues)
If Not S Is Nothing Then
firstAddress = S.Address
Do
CE = Worksheets("Default").Cells(S.Row, 7).Value
AC = Worksheets("Default").Cells(S.Row, 8).Value
BC = Worksheets("Default").Cells(S.Row, 9).Value
SRow = S.Row
Set S = .FindNext(S)
SLastRowBeforeNextS = S.Row - 1
'Insert
For i = SRow + 1 To SLastRowBeforeNextS
If (Worksheets("Default").Cells(i, 4).Value = "tt" Or Worksheets("Default").Cells(i, _
4).Value = "int" Or Worksheets("Default").Cells(i, 4).Value = "felt") And (Worksheets("Default").Cells(i, 14).Value = "Y" Or Worksheets("Default").Cells(i, 14).Value = "N") Then
Worksheets("Default").Cells(i, 8).Value = AC
Worksheets("Default").Cells(i, 9).Value = BC
End If
If Worksheets("Default").Cells(i, 7).Value = "" Then
Worksheets("Default").Cells(i, 7).Value = CE
End If
If Not Worksheets("Default").Cells(i, 7).Value = CE Then
MsgBox "Ungleicher Inhalt in Zelle G" & i & ", Wert: " & Worksheets("Default " _
).Cells(i, 7).Value"
' Hier kannst du auch wieder weiter machen, z.B. den Befehl zum einfügen von _
_
CE verwenden oder
'den
Sub verlassen. Ich weiss leider nicht, wie du damit umgehen wolltest.
End If
Next i
Loop While Not S Is Nothing And S.Address firstAddress
End If
End With
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub