Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

VBA Makro Wörter suchen und auszählen


Betrifft: VBA Makro Wörter suchen und auszählen von: Sandro
Geschrieben am: 25.07.2018 07:18:36

Hi, ich bins nochmal.

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

https://www.herber.de/bbs/user/122870.xlsm

  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Sandro
Geschrieben am: 25.07.2018 12:20:43

Ist das Scripting.Dictionary dabei hilfreich?


  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Nepumuk
Geschrieben am: 25.07.2018 12:42:30

Hallo Sandro,

folgende Funktion gibt dir den String zurück den du in der MsgBox anzeigen willst:

Public Function CountSheath() As String
    Dim avntValues As Variant, vntItem As Variant, vntKey As Variant
    Dim objDictionary As Object
    With Tabelle5
        avntValues = .Range(.Cells(2, 14), .Cells(.Rows.Count, 14).End(xlUp)).Value2
    End With
    Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
    For Each vntItem In avntValues
        If objDictionary.Exists(vntItem) Then
            objDictionary.Item(vntItem) = objDictionary.Item(vntItem) + 1
        Else
            objDictionary(vntItem) = 1
        End If
    Next
    For Each vntKey In objDictionary.Keys
        CountSheath = CountSheath & vntKey & " " & CStr(objDictionary.Item(vntKey)) & " "
    Next
    Set objDictionary = Nothing
End Function

Wie du siehst lagst du mit dem Dictionary richtig. :-)

Gruß
Nepumuk


  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Sandro
Geschrieben am: 25.07.2018 14:37:02

Hi Nepumuk,

das freut mich zwar, dass ich da den richtigen Riecher hatte, allerdings komme ich so auch nicht so recht weiter und finde das Scripting.Dictionary ohne den Bezug auf meine Datei nicht verständlich irgendwie...

Ich weiß nicht, was ich alles umschreiben müsste, um das Scripting.Dictionary in meiner Datei nutzen zu können.

Kannst du oder jemand anderes mir da evtl. weiterhelfen?

Gruß
Sandro


  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Nepumuk
Geschrieben am: 25.07.2018 15:05:53

Hallo Sandro,

kopiere den Code in ein Standardmodul und ruf die Funktion so auf:

Public Sub Beispiel()
    Call MsgBox(CountSheath)
End Sub

Gruß
Nepumuk


  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Sandro
Geschrieben am: 25.07.2018 15:23:21

Jetzt habe ich es auch verstanden :D, ist wohl zu warm heute...

Vielen Dank!


  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Sandro
Geschrieben am: 30.07.2018 07:40:30

Hi Nepumuk,

ich bins doch nochmal,

das Dictionary hilft mir schonmal gut weiter.

Allerdings brauche ich nicht alle Werte aus Tabelle 5, sondern jeweils nur von denen, die ich auf Tabelle 2 stehen habe (die Werte dort in Spalte B variieren und die dazuzugehörige "Mantelart" brauche ich dann)

Gruß
Sandro


  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Nepumuk
Geschrieben am: 30.07.2018 09:07:09

Hallo Sandro,

und wo genau sprich in welchen Zellen stehen die Bezeichnungen in der Tabelle Kalkulation?

Gruß
Nepumuk


  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Sandro
Geschrieben am: 30.07.2018 09:29:16

Hallo Nepumuk,

danke für die schnelle Reaktion. Es soll nur die Mantelart angezeigt werden für Werte Aus Spalte B, die mit "AB" beginnen. Die genauen Positionen der Zellen variieren, sprich man müsste nach Zellen suchen, die mit "AB" beginnen.

Gruß Sandro


  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Nepumuk
Geschrieben am: 30.07.2018 09:39:54

Hallo Sandro,

das sind aber Artikelnummern und keine Mantelbezeichnungen. Muss ich dann nicht in Spalte B an Stelle von Spalte N der Tabelle CFBlanco2018 suchen?

Gruß
Nepumuk


  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Sandro
Geschrieben am: 30.07.2018 09:51:49

Hallo Nepumuk,

also die Artikelnummern aus Spalte B der Tabelle "Kalkulation" sollen in der Tabelle "CFBlanco2018" in Spalte B gesucht werden und dann soll jeweils die Mantelbezeichnung anhand des Dictionarys gezählt werden.

Also wenn ich in der Tabelle "Kalkulation" insgesamt z.B. 5 Artikelnummern stehen habe, dann sollten auch nur die 5 dargestellt werden und nicht alle anderen Mantelbezeichnungen, die noch in der Tabelle "CFBlanco2018" vorhanden sind. (in der MessageBox dann z.B. so: PVC:3 DA:2 und diese Aufzählungen dann untereinander anstatt nebeneinander aufgelistet)

Gruß
Sandro


  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Nepumuk
Geschrieben am: 30.07.2018 10:59:56

Hallo Sandro,

so?

Option Explicit

Public Function CountSheath() As String
    Dim avntValues As Variant, vntItem As Variant, vntKey As Variant
    Dim objDictionary As Object, objCell As Range
    With Tabelle2
        avntValues = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Value2
    End With
    Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
    With Tabelle5
        For Each vntItem In avntValues
            If Not IsEmpty(vntItem) Then
                Set objCell = .Columns(2).Find(What:=vntItem, _
                    LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                If Not objCell Is Nothing Then
                    With objCell.Offset(0, 12)
                        If objDictionary.Exists(.Value) Then
                            objDictionary.Item(.Value) = objDictionary.Item(.Value) + 1
                        Else
                            objDictionary(.Value) = 1
                        End If
                    End With
                    Set objCell = Nothing
                End If
            End If
        Next
    End With
    For Each vntKey In objDictionary.Keys
        CountSheath = CountSheath & vntKey & " " & CStr(objDictionary.Item(vntKey)) & " "
    Next
    Set objDictionary = Nothing
End Function

Public Sub Beispiel()
    Call MsgBox(CountSheath)
End Sub

Gruß
Nepumuk


  

Betrifft: AW: VBA Makro Wörter suchen und auszählen von: Sandro
Geschrieben am: 30.07.2018 11:50:24

Perfekt! Vielen lieben Dank :)

Gruß
Sandro


Beiträge aus dem Excel-Forum zum Thema "VBA Makro Wörter suchen und auszählen"