none
Gemeinsame Anzahl von 3 Spalten mit Text ermitteln RRS feed

  • Frage

  • Hallo zusammen,

    ich hoffe meine Frage Verständlich formulieren zu können.

    Ich habe drei Spalten mit Text. Es gibt verschiedene Einträge, aber die Inhalte der Spalten wiederholen sich.

    Es kommt öfter vor, das in den Spalten die selbe Kombination vorkommt.

    Ich würde gerne ermitteln, welche Kombination wie oft vorkommt.

    Gerade habe ich keine einzige Idee wie ich diesen Sachverhalt angehen muss. Habt Ihr vielleicht eine?

    Donnerstag, 8. Dezember 2011 10:36

Antworten

  • Hallo Hakan Tas...

    was den Aufwand zum Erlernen der Makroprogrammierung betrifft, das kann ich so nicht beurteilen, weil das m.E. auch von Lerngeschwindigkeit und Vorwissen abhängt. Aber der Einstieg und Hürden dabei sind wiederum meines Erachtens schneller zu bewältigen als in manch' anderer Programmiersprache. Denn ein großer Vorteil bei Excel VBA ist, dass man relativ schnell "sieht" wie sich die Makros auswirken.

    Ich hab' den Code mal ein bißchen erweitert, kannst jetzt 2 Tabellen (Quelle und Ziel) angeben. Damit das funktioniert, müssen die Tabellen vor der Ausführung aber auch existieren.

     Option Explicit
      
      Public Sub AnzahlErmitteln()
        
        Dim arrEins   As Variant
        Dim arrZwei   As Variant
        Dim arrDrei   As Variant
        Dim objDic    As Object
        
        Dim strTemp   As String
        Dim strQuelle As String
        Dim strZiel   As String
        
        Dim lngIndex  As Long
        
    '   Dictionary Objekt erstellen...
        
        Set objDic = CreateObject("Scripting.Dictionary")
        
    '   Tabellen festlegen, hier musst Du dann die Namen der Tabellen angeben,
    '   im Beispiel sind das die Tabelle Quelle und Ziel ...
        
        strQuelle = "Quelle"
        strZiel = "Ziel"
        
    '   Bereich festlegen, darauf achten das alle gleich hoch sind,
    '   hier in dem Beispiel = 50
    '
    '   In den Arrays sind dann jeweils 50 Zeilen enthalten und jedes Array
    '   hat eine Breite von 1.
    '
    '   Im Verhältnis zur vorherigen Version steht jetzt ein . vor dem
    '   Range, diese ist dann damit referenziert auf die Tabelle strQuelle
    '   entspricht ThisWorkbook.Worksheets(strQuelle).Range("A2:A50")
    
        With ThisWorkbook.Worksheets(strQuelle)
          
          arrEins = .Range("A2:A50")  ' Erster  Bereich, ggf. anpassen
          arrZwei = .Range("C2:C50")  ' Zweiter Bereich, ggf. anpassen
          arrDrei = .Range("E2:E50")  ' Dritter Bereich, ggf. anpassen
          
        End With
        
    '   Zusammensetzen...
        
        For lngIndex = 1 To UBound(arrEins)
          
    '     Zeile für Zeile zusammensetzen...
          
          strTemp = Join(Array(arrEins(lngIndex, 1), arrZwei(lngIndex, 1), arrDrei(lngIndex, 1)), "---")
          
    '     Dem Dictionary hinzufügen und Antahl erhöhen...
          
          objDic(strTemp) = objDic(strTemp) + 1
          
        Next
        
    '   Ergebnisse schreiben, hier startet (!) es ab Zelle A1 und B1 in der Zieltabelle...
        
        With ThisWorkbook.Worksheets(strZiel)
          
         .Range("A1").Resize(objDic.Count) = WorksheetFunction.Transpose(objDic.keys)
         .Range("B1").Resize(objDic.Count) = WorksheetFunction.Transpose(objDic.items)
          
        End With
        
    '   Dictionary Objekt löschen...
        
        Set objDic = Nothing
        
      End Sub

    Gruß

     


    MVP Office System · Excel Formula Translator · www.excel-translator.de
    • Bearbeitet Mourad LouhaMVP Donnerstag, 8. Dezember 2011 16:44
    • Als Antwort vorgeschlagen Alex Pitulice Montag, 12. Dezember 2011 11:28
    • Als Antwort markiert Hakan Tas Montag, 12. Dezember 2011 17:35
    Donnerstag, 8. Dezember 2011 16:43

Alle Antworten

  • Hallo Hakan Tas...

    ich vermute, es handelt sich hierbei um Excel, richtig?

    Spontan würde mir zunächst die Excel Formel ZÄHLENWENN(Bereich;Suchtext) einfallen, wo Du als Bereich den Bereich eingibst bzw. auswählst, der durchsucht werden soll, z.B. $A1$A100. Als Suchtext kannst Du wiederum den Inhalt einer Zelle angeben, z.B. $B$1. Siehe auch Excel Hilfe zu der Formel, wo auch Beispiele zu finden sind.

    Wenn Du spezielle weitere Anforderungen hast, müsstest Du diese meines Erachtens mehr konkretisieren.

    Gruß


    MVP Office System · Excel Formula Translator · www.excel-translator.de
    Donnerstag, 8. Dezember 2011 11:01
  • Das Problem ist bei der Zählenwenn, dass ich unmengen von Suchtexten berücksichtigen müssen. Sobald ein neuer Text hinzukommt, müsste auch die Zählenwenn Anweisung verändert werden.

     

    Ich habe freundlicherweise folgendes Makro genannt bekommen, das genau mein Problem löst, allerdings ist es hier zwingend notwenig, das die Spalten nebeneinander liegen müssen. Genau das ist bei mir nicht der Fall, ich versuche das Makro zu optimieren. Habe noch nie mit Makros gearbeitet, daher ist es eher ein Glücksspiel.

    In diesem Beispiel ist A2:C30 der zu durchsuchende Bereich und in den Spalten D2 und E2 wird das Ergebnis ausgegeben.

    Option Explicit


    Public Sub test()
    Dim arr As Variant
    Dim myDic As Object
    Dim strtmp As String
    Dim L As Long
    Set myDic = CreateObject("Scripting.Dictionary")
    arr = Range("A2:C30")    
    For L = 1 To UBound(arr)
        strtmp = Join(Array(arr(L, 1), arr(L, 2), arr(L, 3)), "---")
        myDic(strtmp) = myDic(strtmp) + 1
    Next
    Range("D2").Resize(myDic.Count) = WorksheetFunction.Transpose(myDic.keys)
    Range("E2").Resize(myDic.Count) = WorksheetFunction.Transpose(myDic.items)
    End Sub

    Donnerstag, 8. Dezember 2011 13:34
  • Hallo Hakan Tas...

    ich habe das Makro leicht angepasst und kommentiert und hoffe, es ist soweit verständlich und Du kannst es nachvollziehen...

    Option Explicit
    
    Public Sub AnzahlErmitteln()
      
      Dim arrEins   As Variant
      Dim arrZwei   As Variant
      Dim arrDrei   As Variant
      Dim objDic    As Object
      Dim strTemp   As String
      Dim lngIndex  As Long
      
    ' Dictionary Objekt erstellen...
      
      Set objDic = CreateObject("Scripting.Dictionary")
      
    ' Bereich festlegen, darauf achten das alle gleich hoch sind,
    ' hier in dem Beispiel = 50
    '
    ' In den Arrays sind dann jeweils 50 Zeilen enthalten und jedes Array
    ' hat eine Breite von 1.
      
      arrEins = Range("A2:A50")  ' Erster  Bereich, ggf. anpassen
      arrZwei = Range("C2:C50")  ' Zweiter Bereich, ggf. anpassen
      arrDrei = Range("E2:E50")  ' Dritter Bereich, ggf. anpassen
      
    ' Zusammensetzen...
      
      For lngIndex = 1 To UBound(arrEins)
        
    '   Zeile für Zeile zusammensetzen...
        
        strTemp = Join(Array(arrEins(lngIndex, 1), arrZwei(lngIndex, 1), arrDrei(lngIndex, 1)), "---")
        
    '   Dem Dictionary hinzufügen und Antahl erhöhen...
        
        objDic(strTemp) = objDic(strTemp) + 1
        
      Next
      
    ' Ergebnisse schreiben, hier startet (!) es ab Zelle F2 und G2, ggf. Anpassen und Luft nach unten lassen...
      
      Range("F2").Resize(objDic.Count) = WorksheetFunction.Transpose(objDic.keys)
      Range("G2").Resize(objDic.Count) = WorksheetFunction.Transpose(objDic.items)
      
    ' Dictionary Objekt löschen...
      
      Set objDic = Nothing
      
    End Sub
    

     

    Gruß


    MVP Office System · Excel Formula Translator · www.excel-translator.de

    Donnerstag, 8. Dezember 2011 15:11
  • Hallo Mourad Louha,

    alleshöchsten Respekt. Wie lange muss man sich eigentlich mit Makro Programmierung beschäftigen um solche Wünsche lösen zu können.

    Manchmal Frage ich mich ob es sich um ein Baukastensystem handelt ;)

    Ich danke dir, habe es getestet und es Funktioniert einwandfrei.

    Besteht eine Möglichkeit ohne zuviel zu wünschen, auch das Ergebnis der Auswertung oder das Gesamte Makro auf einem anderem Tabellenblatt auszuführen/anzuzeigen?

    Als Praktisches Beispiel soll das Ergebnis der Auswertung in TabelleA angezeigt werden, wobei die Ihalte für die Auswertung sich in TabelleB befinden.

    Vorab schonmal Herzlichen Dank für deine bereits geleistete Unterstützung.


    • Bearbeitet Hakan Tas Donnerstag, 8. Dezember 2011 16:34
    Donnerstag, 8. Dezember 2011 16:15
  • Hallo Hakan Tas...

    was den Aufwand zum Erlernen der Makroprogrammierung betrifft, das kann ich so nicht beurteilen, weil das m.E. auch von Lerngeschwindigkeit und Vorwissen abhängt. Aber der Einstieg und Hürden dabei sind wiederum meines Erachtens schneller zu bewältigen als in manch' anderer Programmiersprache. Denn ein großer Vorteil bei Excel VBA ist, dass man relativ schnell "sieht" wie sich die Makros auswirken.

    Ich hab' den Code mal ein bißchen erweitert, kannst jetzt 2 Tabellen (Quelle und Ziel) angeben. Damit das funktioniert, müssen die Tabellen vor der Ausführung aber auch existieren.

     Option Explicit
      
      Public Sub AnzahlErmitteln()
        
        Dim arrEins   As Variant
        Dim arrZwei   As Variant
        Dim arrDrei   As Variant
        Dim objDic    As Object
        
        Dim strTemp   As String
        Dim strQuelle As String
        Dim strZiel   As String
        
        Dim lngIndex  As Long
        
    '   Dictionary Objekt erstellen...
        
        Set objDic = CreateObject("Scripting.Dictionary")
        
    '   Tabellen festlegen, hier musst Du dann die Namen der Tabellen angeben,
    '   im Beispiel sind das die Tabelle Quelle und Ziel ...
        
        strQuelle = "Quelle"
        strZiel = "Ziel"
        
    '   Bereich festlegen, darauf achten das alle gleich hoch sind,
    '   hier in dem Beispiel = 50
    '
    '   In den Arrays sind dann jeweils 50 Zeilen enthalten und jedes Array
    '   hat eine Breite von 1.
    '
    '   Im Verhältnis zur vorherigen Version steht jetzt ein . vor dem
    '   Range, diese ist dann damit referenziert auf die Tabelle strQuelle
    '   entspricht ThisWorkbook.Worksheets(strQuelle).Range("A2:A50")
    
        With ThisWorkbook.Worksheets(strQuelle)
          
          arrEins = .Range("A2:A50")  ' Erster  Bereich, ggf. anpassen
          arrZwei = .Range("C2:C50")  ' Zweiter Bereich, ggf. anpassen
          arrDrei = .Range("E2:E50")  ' Dritter Bereich, ggf. anpassen
          
        End With
        
    '   Zusammensetzen...
        
        For lngIndex = 1 To UBound(arrEins)
          
    '     Zeile für Zeile zusammensetzen...
          
          strTemp = Join(Array(arrEins(lngIndex, 1), arrZwei(lngIndex, 1), arrDrei(lngIndex, 1)), "---")
          
    '     Dem Dictionary hinzufügen und Antahl erhöhen...
          
          objDic(strTemp) = objDic(strTemp) + 1
          
        Next
        
    '   Ergebnisse schreiben, hier startet (!) es ab Zelle A1 und B1 in der Zieltabelle...
        
        With ThisWorkbook.Worksheets(strZiel)
          
         .Range("A1").Resize(objDic.Count) = WorksheetFunction.Transpose(objDic.keys)
         .Range("B1").Resize(objDic.Count) = WorksheetFunction.Transpose(objDic.items)
          
        End With
        
    '   Dictionary Objekt löschen...
        
        Set objDic = Nothing
        
      End Sub

    Gruß

     


    MVP Office System · Excel Formula Translator · www.excel-translator.de
    • Bearbeitet Mourad LouhaMVP Donnerstag, 8. Dezember 2011 16:44
    • Als Antwort vorgeschlagen Alex Pitulice Montag, 12. Dezember 2011 11:28
    • Als Antwort markiert Hakan Tas Montag, 12. Dezember 2011 17:35
    Donnerstag, 8. Dezember 2011 16:43
  • Hallo Mourad,

     

    entschuldigen Sie  meine verspätete Antwort, wurde leider etwas aufgehalten.

    Ihr Makro funktioniert Einwandfrei. Herzlichen Dank, das ist sehr freundlich gewesen.

    Ich habe vergleichbare Makros gesehen und muss sagen das Ihres am einfachsten zu verstehen und anzuwenden ist.

    Was wiederrum für Ihre Qualifikation spricht.

    Programmierung war noch nie einer meiner Favorierten, nur leider muss ich erfahren das es manchmal unungänglich ist und mal eben sich da reinarbeiten, ist nicht möglich.

    Auf diesem niveau wird selten Unterstützung geleistet, super Sache Mourad, danke Ihnen.

    Freitag, 9. Dezember 2011 10:18
  • Hallo Hakan,

     

    Hat Dir die Antwort von Mourad geholfen? Wenn ja - bitte markiere den Beitrag "als Antwort".

     

    Danke und Grüß,

    Alex

    Montag, 12. Dezember 2011 11:28
  • Ok, habe ich gemacht.
    Montag, 12. Dezember 2011 17:36