Excel: Zählen von Wörtern

Dieses Thema Excel: Zählen von Wörtern im Forum "Microsoft Office Suite" wurde erstellt von falcon30, 17. Aug. 2005.

Thema: Excel: Zählen von Wörtern Hallo Zusammen, ich habe folgendes Problem: Ich habe mehrere Arbeitsblätter die gleich aufgebaut sind. In den...

  1. Hallo Zusammen,

    ich habe folgendes Problem:

    Ich habe mehrere Arbeitsblätter die gleich aufgebaut sind. In den Zellen
    D10 bis D20; D30 bis D40; H10 bis H20; H30 bis H40;
    L10 bis L20; L30 bis L40;P10 bis P20 und P30 bis P40

    habe ich folgende Einträge:
    M1: löjdslajödklajdöfl
    M2: äsroitüqwopeiqp
    M3: löasdkjpüroeiq+ü
    ...
    M100: sdlökfjaädlöj

    Es können auch mehrere dieser M*s in einer Zelle sein.

    Ich muss diese M*s zählen und in der Zelle C6 ausgeben.

    Könnt Ihr mir da helfen?

    Vielen Dank im Voraus.

    Grüße
    falcon30
     
  2. Hallo falcon30,

    dir kann geholfen werden ;D

    Kann man den Doppelpunkt als Zählkriterium verwenden oder taucht der in den Begriffen mehrmals auf ?

    Gruß Matjes :)
     
  3. Hallo Matjes,

    den Doppelpunkt kann natürlich auch als Zählkriterium verwenden.

    Tritt zur Zeit nicht mehrfach auf.

    Grüße
    falcon30
     
  4. Hi falcon30,

    dann probier dies mal.

    Gruß Matjes :)
    Code:
    Option Explicit
    Sub ZaehlenVonWorten()
     ->*** in den Ranges werden die Doppelpunkte gezählt
     ->*** und in der Ergebniszelle gespeichert
    
      Const c_Range_Ergebnis = C6
      
      Dim f_Ranges() As String, l_Ranges_cnt As Long
      Dim Doppelpunkt_cnt As Long, s_Text As String
      Dim pos As Long, x As Long
      Dim ws As Worksheet, Zelle As Range
      
      Call ZaehlenVonWortenInit(f_Ranges())
      
      Set ws = ActiveSheet
      
      Doppelpunkt_cnt = 0
      
      For x = LBound(f_Ranges()) To UBound(f_Ranges())
        For Each Zelle In ws.Range(f_Ranges(x))
          s_Text = Zelle.Value
          pos = 0
          Do
            pos = InStr(pos + 1, s_Text, :)
            If pos <> 0 Then Doppelpunkt_cnt = Doppelpunkt_cnt + 1
          Loop While pos <> 0
        Next
      Next
      
      ws.Range(c_Range_Ergebnis).Value = Doppelpunkt_cnt
      
      Set ws = Nothing: Set Zelle = Nothing
    End Sub
    
    Private Function ZaehlenVonWortenInit(f_Ranges() As String)
      
      ReDim f_Ranges(1 To 8)
      f_Ranges(1) = D10:D20
      f_Ranges(2) = D30:D40
      f_Ranges(3) = H10:H20
      f_Ranges(4) = H30:H40
      f_Ranges(5) = L10:L20
      f_Ranges(6) = L30:L40
      f_Ranges(7) = P10:P20
      f_Ranges(8) = P30:P40
      
    End Function
     
  5. Hallo Matjes,

    funktioniert bis jetzt genau so wie gewünscht.

    Doch hätte ich 2 Fragen:

    1. gibt es die Möglichkeit den Buchstaben M mit zu berücksichtigen.

    2. Wie schaffe ich es, dass das Makro automatisch zählt.

    Grüße
    falcon30
     
  6. Hallo falcon30,

    das ist schon etwas komplizierter.

    Dieses in ein Modul:
    Code:
    Option Explicit
    Type myMRange_struct
      s_Range As String
      l_Spalte_von As Long
      l_Spalte_bis As Long
      l_Zeile_von As Long
      l_Zeile_bis As Long
    End Type
    
    Public f_Ranges() As myMRange_struct
    
    Function ZaehlenVonWorten2()
     ->*** in den Ranges werden die Doppelpunkte gezählt
     ->*** und in der Ergebniszelle gespeichert
    
      Const c_Range_Ergebnis = C6
      
      Dim M_cnt As Long, s_Text As String, x As Long
      Dim ws As Worksheet, Zelle As Range
      
      Set ws = ActiveSheet
      
      M_cnt = 0
      
      For x = LBound(f_Ranges()) To UBound(f_Ranges())
        For Each Zelle In ws.Range(f_Ranges(x).s_Range)
          s_Text = Zelle.Value
          M_cnt = M_cnt + Mxxx_Doppelpunkt_Zaehlen(s_Text)
        Next
      Next
      
      ws.Range(c_Range_Ergebnis).Value = M_cnt
      
      Set ws = Nothing: Set Zelle = Nothing
    End Function
    '******************************************************
    Private Function Mxxx_Doppelpunkt_Zaehlen(s_Text As String) As Long
     ->*** zaehlt die Vorkommen von Mxxx: im String
      
        Const c_MaxAnzZeichenKennung_Mxxx = 6
        
        Dim pos_M As Long, pos_x As Long, s As String
        
        Mxxx_Doppelpunkt_Zaehlen = 0
        
        pos_M = 0
        Do
          pos_M = InStr(pos_M + 1, s_Text, M)
          If pos_M <> 0 Then
            For pos_x = pos_M + 1 To Len(s_Text)
              If (pos_x - pos_M) > c_MaxAnzZeichenKennung_Mxxx Then Exit For
              s = Mid(s_Text, pos_x, 1)
              Select Case s
                Case 0 To 9,  
                Case :
                  Mxxx_Doppelpunkt_Zaehlen = Mxxx_Doppelpunkt_Zaehlen + 1
                  Exit For
                Case Else: Exit For
              End Select
            Next
          End If
        Loop While pos_M <> 0
    
    End Function
    
    '******************************************************
    Public Function ZaehlenVonWortenInit2()
    
      Dim x As Long, r As Range, ws As Worksheet
      
      ReDim f_Ranges(1 To 8)
      f_Ranges(1).s_Range = D10:D20
      f_Ranges(2).s_Range = D30:D40
      f_Ranges(3).s_Range = H10:H20
      f_Ranges(4).s_Range = H30:H40
      f_Ranges(5).s_Range = L10:L20
      f_Ranges(6).s_Range = L30:L40
      f_Ranges(7).s_Range = P10:P20
      f_Ranges(8).s_Range = P30:P40
      
      
      Application.ScreenUpdating = False
      
      Set ws = ActiveWorkbook.Worksheets.Add
      For x = LBound(f_Ranges()) To UBound(f_Ranges())
        Set r = ws.Range(f_Ranges(x).s_Range)
        f_Ranges(x).l_Spalte_von = r.Column
        f_Ranges(x).l_Zeile_von = r.Row
        f_Ranges(x).l_Spalte_bis = r.Column + r.Columns.Count - 1
        f_Ranges(x).l_Zeile_bis = r.Row + r.Rows.Count - 1
        Set r = Nothing
      Next
      
      Application.DisplayAlerts = False
      ws.Delete
      Application.DisplayAlerts = True
      
      Application.ScreenUpdating = True
      
      Set r = Nothing: Set ws = Nothing
    End Function
    Das Change-Ereignis für die Tabelle überwachen.
    (Diesen Teil in die Code-Seite des entsprechenden Blattes)
    Code:
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
      
      Dim Zelle As Range, x As Long, b_relevant As Boolean
      
      
     ->Pruefen, ob Änderung relevant für ZaehlenVonWorten2
      b_relevant = False
      For Each Zelle In Target
        For x = LBound(f_Ranges()) To UBound(f_Ranges())
          If _
            (Zelle.Row >= f_Ranges(x).l_Zeile_von) And _
            (Zelle.Row <= f_Ranges(x).l_Zeile_bis) And _
            (Zelle.Column >= f_Ranges(x).l_Spalte_von) And _
            (Zelle.Column <= f_Ranges(x).l_Spalte_bis) Then
            b_relevant = True
            GoTo AUSWERTEN
          End If
        Next
      Next
    AUSWERTEN:
      Set Zelle = Nothing
      If b_relevant Then
       ->Ereignisse abstellen, sonst Schleife
        Application.EnableEvents = False
        Call ZaehlenVonWorten2
        Application.EnableEvents = True
      End If
    End Sub
    Damit die Funktionen im Modul und das Change-Ereignis mit einer gefüllten Struktur f_Ranges() vorsorgt werden, muß die Initialisierung beim Öffnen der Arbeitsmappe einmalig aufgerufen werden.
    (Diesen Code in die Code-Seite der Arbeitsmappe (DieseArbeitsmappe))
    Code:
    Private Sub Workbook_Open()
      Call ZaehlenVonWortenInit2
    End Sub
    Dann das Ganze speichern und die Arbeitsmappe schließen und wieder öffnen.

    Ein Änderung im relevanten Bereich durchführen und schauen, ob das Ergebnis in C6 ok ist.

    Ab jetzt wird dann bei jeder Änderung im relevanten Bereich automatisch neu gezählt.

    Gruß Matjes :)
     
  7. Hallo Matjes,

    vielen Dank!!

    Funktioniert echt klasse!!

    Grüße
    falcon30
     
Die Seite wird geladen...

Excel: Zählen von Wörtern - Ähnliche Themen

Forum Datum
Excel Buchstabenkombination z.B. "ABC" durch Zahlenkombination z.B."1,2,3" ersetzen Microsoft Office Suite 29. Juli 2013
Excel 2010 - Spalten automatisch zählen Windows XP Forum 22. Apr. 2013
Excel, Zahlen werden zum Datum Microsoft Office Suite 29. Okt. 2010
negative Zahlen Excel 2000 Microsoft Office Suite 25. Nov. 2009
Excel - Buchstaben im Hintergrund durch Zahlen ersetzen, um zu berechnen Microsoft Office Suite 8. Okt. 2009