Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Excel Makro Wörter suchen und auszählen
25.07.2018 09:33:28 Sandro
NotSolved
25.07.2018 09:38:01 Gast57810
NotSolved

Ansicht des Beitrags:
Von:
Sandro
Datum:
25.07.2018 09:33:28
Views:
1289
Rating: Antwort:
  Ja
Thema:
VBA Excel Makro Wörter suchen und auszählen

Hallo Leute!

Ich muss den Code so ergänzen, dass mir eine "OkAbbrechen-Messagebox" angezeigt wird, die folgendes beeinhaltet:

- ein Wert (z.B. "PUR", "SPEZIAL", "PE", "DA", "TPE", "PVC"), soll 12 Spalten weiter entnommen werden und das bei allen auf WS1 festgestellten Positionen

- die Messagebox soll alle Anzahlen anzeigen also z.B. Anzahl "PUR": 6, Anzahl "SPEZIAL": 3, Anzahl "PE": 4 usw.

- dazu dann die Abfrage: "Ist das so in Ordnung?" bei "Ok" nichts tun und bei "Abbrechen" dann den "c.Interior.ColorIndex = xlNone"-Befehl

Ich habe schonmal angefangen (siehe Tabelle2 (Kalkulation) in VBA), komme allerdings leider nicht weiter.

Vielen Dank im Voraus!
Gruß Sandro

 

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
    
        'WorksheetFunction.VLookup(c, WS2.Range("B:N"), 13, 0).Value
    End If
Next c
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot VBA Excel Makro Wörter suchen und auszählen
25.07.2018 09:33:28 Sandro
NotSolved
25.07.2018 09:38:01 Gast57810
NotSolved