<span style="color: rgb(102, 102, 102); font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; font-size: 14px;">Hallo Leute!</span>
<span style="color: rgb(102, 102, 102); font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; font-size: 14px;">Ich muss den Code so ergänzen, dass mir eine "OkAbbrechen-Messagebox" angezeigt wird, die folgendes beeinhaltet:</span>
<span style="color: rgb(102, 102, 102); font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; font-size: 14px;">- ein Wert (z.B. "PUR", "SPEZIAL", "PE", "DA", "TPE", "PVC"), soll 12 Spalten weiter entnommen werden und das bei allen auf WS1 festgestellten Positionen</span>
<span style="color: rgb(102, 102, 102); font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; font-size: 14px;">- die Messagebox soll alle Anzahlen anzeigen also z.B. Anzahl "PUR": 6, Anzahl "SPEZIAL": 3, Anzahl "PE": 4 usw.</span>
<span style="color: rgb(102, 102, 102); font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; font-size: 14px;">- dazu dann die Abfrage: "Ist das so in Ordnung?" bei "Ok" nichts tun und bei "Abbrechen" dann den "c.Interior.ColorIndex = xlNone"-Befehl</span>
<span style="color: rgb(102, 102, 102); font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; font-size: 14px;">Ich habe schonmal angefangen (siehe Tabelle2 (Kalkulation) in VBA), komme allerdings leider nicht weiter.</span>
<span style="color: rgb(102, 102, 102); font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; font-size: 14px;">Vielen Dank im Voraus!</span>
<span style="color: rgb(102, 102, 102); font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; font-size: 14px;">Gruß Sandro
Hier der Code:</span>
Option Explicit
Private Sub CheckBox3_Click()
Dim zelle As Range
Dim letzte As Long
Dim strAusgabe As String
With Worksheets("Kalkulation")
For Each zelle In Worksheets("Kalkulation").Range("A1:C1000")
If CheckBox3 = True And zelle.Interior.ColorIndex = 3 Then
zelle.Interior.ColorIndex = 2 And zelle.Borders(xlEdgeTop).LineStyle = xlContinuous
End If
Next
End With
End Sub
Private Sub CheckBox4_Click()
If CheckBox4 = True Then
Dim zelle As Range
Dim letzte As Long
Dim strAusgabe As String
With Worksheets("Kalkulation")
For Each zelle In Worksheets("Kalkulation").Range("A1:C1000")
If zelle.Interior.ColorIndex = 3 Then
strAusgabe = strAusgabe & vbLf & zelle.Address
End If
Next
MsgBox strAusgabe
End With
End If
End Sub
Private Sub CommandButton2_Click()
Dim WS1 As Worksheet: Set WS1 = Worksheets("Kalkulation")
Dim WS2 As Worksheet: Set WS2 = Worksheets("CFBlanco2018")
Dim c As Range
For Each c In WS1.Columns(2).SpecialCells(xlCellTypeConstants)
If UCase(Left(c, 2)) = "AB" Then
If WS1.Range("E3") <= WorksheetFunction.VLookup(c, WS2.Range("B:J"), 9, 0) Then
c.Interior.ColorIndex = 3
If WS1.OLEObjects("CheckBox3").Object.Value Then MsgBox "Fehler: " & c
Else
c.Interior.ColorIndex = xlNone
End If
End If
Next c
End Sub
Private Sub CommandButton3_Click()
Dim WS1 As Worksheet: Set WS1 = Worksheets("Kalkulation")
Dim WS2 As Worksheet: Set WS2 = Worksheets("CFBlanco2018")
Dim c As Range
For Each c In WS1.Columns(2).SpecialCells(xlCellTypeConstants)
If UCase(Left(c, 2)) = "AB" Then
If MsgBox("Ist die Anzahl der Qualitäten in Ordnung?" & vbCr & vbCr & vbCr & "Objekt für Anzahl der Qualitäten!", vbOKCancel, "Anzahl Qualitäten") = vbOK Then
MsgBox "Prima!"
Else
MsgBox "Der Vorgang wurde abgebrochen."
End If
End If
Next c
End Sub