VBA Makro Wörter suchen und auszählen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

Beliebteste Forumthreads (12 Monate)

VBA Makro Wörter suchen und auszählen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

328 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Makro Wörter suchen und auszählen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

328 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread