Mengenverteilung / Häufigkeit bestimmter Begriffe

Hallo,
leider war ich diese Woche auf Messe und jetzt ist mein Faden ins Archiv (Mengenverteilung Haeufigkeit bestimmter Begriffe) gerutscht. :/ Da mir aber zwei User (neopa C und Sheldon) echt gute Ansätze geliefert haben, würde ich das gerne fortsetzen.
Grundproblem: Ich möchte feststellen, welches Wort einem anderen wie oft zugeordnet werden kann - das Problem: Ich möchte, Beispiel aktuelle Liste und Vorauswahl, nicht nur feststellen, wie oft beispielsweise Wort "A" z. B. auf den Nachnamen Myrl entfällt, sondern z. B. auch auf Benjamin.
Und: Ohne dass ich diesen zusätzlich definieren muss, sprich: Ich möchte nur nach "A" suchen lassen - und am Ende eine Liste erhalten auf welche Nachnamen "A" wie oft entfällt und auf welche Vornamen "A" wie oft entfällt.
https://www.herber.de/bbs/user/113167.xlsx

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Thomas
Nehmen wir mal an deine Tabelle("Auswertung") ist völlig leer.
Lass diesen Code mal laufen:

' **********************************************************************
' Modul: Tabelle2 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Sub machs()
    Dim L As Long, I As Integer
    Dim myDic As Object
    Dim arr As Variant
    Dim strTmp

    Set myDic = CreateObject("Scripting.Dictionary")
    With Sheets("Daten")
        arr = Intersect(.Range("A1").CurrentRegion, .Range("A1").CurrentRegion.Offset(2, 0))
    End With
    'Vor-und Nachnamen ermitteln und eintragen
    For L = LBound(arr) To UBound(arr)
        strTmp = Split(arr(L, 1), " ") 'Vor- und Nachname trennen
        myDic(strTmp(0)) = ""
        myDic(strTmp(1)) = ""
    Next
    Sheets("Auswertung").Range("B1").Resize(1, myDic.Count) = myDic.keys
    myDic.RemoveAll
    'Werte ermitteln und eintragen
    For L = LBound(arr) To UBound(arr)
        For I = 2 To UBound(arr, 2)
            If arr(L, I) <> "" Then
                myDic(arr(L, I)) = 0
            End If
        Next
    Next
    Sheets("Auswertung").Range("A2").Resize(myDic.Count, 1) = WorksheetFunction.Transpose(myDic.keys)
    myDic.RemoveAll

    'Berechnung durchführen und eintrage
    With Sheets("Auswertung")
        With Intersect(.Range("A1").CurrentRegion, .Range("A1").CurrentRegion.Offset(1, 1))
            .FormulaLocal = "=SUMMENPRODUKT(ISTZAHL(FINDEN(B$1;Daten!$A$3:$A$100))*(Daten!$B$3:$J$100=$A2))"
            .Value = .Value
        End With
    End With

End Sub

ransi

Beliebteste Forumthreads (12 Monate)

Mengenverteilung / Häufigkeit bestimmter Begriffe

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread