Anzeige
Archiv - Navigation
1260to1264
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

@ Sepp: Zählenwenn

@ Sepp: Zählenwenn
Claudia
Hallo Sepp,
ich stehe vor dem Problem, dass ich drei Dateien mit jeweils ca. 50.000 Datensätzen habe. Diese solle ich nun schnell auswerten.
Eine Auswertung besteht darin, zu zählen, wie häufig in einem Bereich Begriffe vorkommen.
Dabei soll so vorgegangen werden, dass z.B. alle Begriffe in diesem Bereich in einer neuen Tabelle aufgelistet und die jeweilige Trefferanzahl rechts daneben geschrieben werden soll.
Ein Bereich wäre z.B. AF2:AQ50000. Leere Zellen sollen natürlich nicht gezählt werden.
Wäre das für Dich mit VBA machbar, so dass das Makro auch nicht zu lange läuft? Der jeweilige Bereich müsste einfach änderbar sein - ggf. per Inputbox?
Vielen Dank!
Liebe Grüße
Claudia

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: @ Sepp: Zählenwenn
12.05.2012 13:08:11
Jürgen
Hallo Claudia,
kannst mal ne datei uploaden ?
Gruß Jürgen
AW: @ Sepp: Zählenwenn
12.05.2012 13:14:23
Josef

Hallo Claudia,
sollen alle 600.000 Zellen gezählt werden? Oder nur Begriffe in einer bestimmten Spalte?

« Gruß Sepp »

AW: @ Sepp: Zählenwenn
12.05.2012 14:39:38
Claudia
Hallo Sepp,
alle 600.000 Zellen. Wobei ich auch kein Problem habe, wenn jede Spalte für sich ausgewertet wird. Allerdings müsste die spätere Aufsummierung einfach funktionieren.
Liebe Grüße
Claudia
Anzeige
AW: @ Sepp: Zählenwenn
12.05.2012 16:07:11
Claudia
Hallo Spp,
aufgrund Deiner Frage, ist mir eine bessere Idee für eine Auswertung gekommen. Die Beschreibung findest Du im Beitrag. Wäre toll, wenn Du Dir das mal anschauen könntest. Vielen vielen Dank!
https://www.herber.de/bbs/user/80115.xls
Schaffst Du das?
Liebe Grüße
Claudia
AW: @ Sepp: Zählenwenn
12.05.2012 16:10:02
Claudia
Als Ergänzung: Leerzellen sind sowohl in der Auswertung als auch in der Datenbasis denkbar.
AW: @ Sepp: Zählenwenn
12.05.2012 19:57:52
Josef

Hallo Claudia,
probier mal. (ohne Ausgabe der Spalten)
Sub countEntries()
  Dim rng As Range, rngRow As Range
  Dim lngRow As Long, lngCount As Long, lngCol As Long
  
  On Error Resume Next
  Set rng = Application.InputBox("Bereich auswählen", "Unterschiedliche Einträge", Selection.Address, Type:=8)
  On Error GoTo 0
  
  If Not rng Is Nothing Then
    With Sheets("Auswertung")
      lngRow = 2
      Do While Application.CountA(.Range(.Cells(lngRow, 1), .Cells(lngRow, 12))) > 0
        lngCount = 0
        For Each rngRow In rng.Rows
          For lngCol = 1 To 12
            If .Cells(lngRow, lngCol) <> "" Then
              lngCount = lngCount + Application.CountIf(rngRow, .Cells(lngRow, lngCol))
            End If
          Next
        Next
        .Cells(lngRow, 13) = lngCount
        lngRow = lngRow + 1
      Loop
    End With
  End If
  
End Sub



« Gruß Sepp »

Anzeige
AW: @ Sepp: Zählenwenn
12.05.2012 17:39:29
Josef

Hallo Claudia,
"schnell" ist bei ein paar hunderttausend Zellen natürlich relativ!
Sub countDif()
  Dim rng As Range, r As Range
  Dim vntIn As Variant, vntValue As Variant
  Dim lngCount() As Long, lngIndex As Long
  Dim objSh As Worksheet
  
  Dim lngCalc As Long
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  On Error Resume Next
  Set rng = Application.InputBox("Bereich auswählen", "Unterschiedliche Einträge", Selection.Address, Type:=8)
  On Error GoTo 0
  
  If Not rng Is Nothing Then
    vntIn = rng
    vntValue = toArraySorted(vntIn)
    Redim lngCount(UBound(vntValue))
    For lngIndex = 0 To UBound(vntValue)
      lngCount(lngIndex) = Application.CountIf(rng, vntValue(lngIndex))
    Next
    Set objSh = ThisWorkbook.Worksheets.Add
    With objSh
      .Name = "Anzahl_" & Format(Now, "dd-MM-yy hhmmss")
      .Cells(1, 1).Resize(UBound(vntValue, 1), 1) = Application.Transpose(vntValue)
      .Cells(1, 2).Resize(UBound(vntValue, 1), 1) = Application.Transpose(lngCount)
    End With
  End If
  
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'countDif'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
End Sub


Public Function toArraySorted(Field As Variant, Optional Uniqe As Boolean = True) As Variant
  Dim objArrayList As Object
  Dim lngR As Long, lngC As Long
  
  On Error GoTo ErrExit
  
  Set objArrayList = CreateObject("System.Collections.Arraylist")
  
  With objArrayList
    For lngR = LBound(Field, 1) To UBound(Field, 1)
      For lngC = LBound(Field, 2) To UBound(Field, 2)
        If Not .Contains(Field(lngR, lngC)) Or Not Uniqe Then
          If Field(lngR, lngC) <> "" Then .Add Field(lngR, lngC)
        End If
      Next
    Next
    .Sort
    toArraySorted = .toArray
  End With
  
  Exit Function
  ErrExit:
  toArraySorted = -1
End Function



Deine neue Aufgabe muss ich mir erst anschauen, mit mehreren Ausgaben dauert das aber dann bestimmt noch (viel) länger.

« Gruß Sepp »

Anzeige
AW: @ Sepp: Zählenwenn
12.05.2012 17:57:21
Claudia
Hallo Sepp,
der erste Code funktioniert super. Und für die Menge an Daten super schnell. Max. 5 Minuten.
Super, vielen Dank!
AW: @ Sepp: Zählenwenn
12.05.2012 21:10:40
Claudia
Hallo Sepp,
der zweite Code bringt nicht das gewünschte Ergebnis. Ich glaube, Du wirst mich steinigen - weil es wohl an einer falschen Vorgabe liegt.
Es soll nur gezählt werden, wenn die gesamte Suchkombination aus dem Reiter Auswertung (also z.B. Test 1, Test 2 und Test 3 ) in der betreffenden Zeile der anderen Datei gefunden wird - und dabei kann es so sei, dass in der anderen Datei die Werte in anderer Reihenfolge stehen (z.B. Test 3, Test 2, Test 1).
Habe das Gefühl, dass gezählt wird, wenn bereits ein Treffer.
Anzeige
AW: @ Sepp: Zählenwenn
12.05.2012 22:07:57
Josef

Hallo Claudia,
dann so.
Sub countEntries()
  Dim rng As Range, rngRow As Range
  Dim lngRow As Long, lngCol As Long
  Dim bolCount As Boolean
  Dim lngCalc As Long
  
  On Error Resume Next
  Set rng = Application.InputBox("Bereich auswählen", "Unterschiedliche Einträge", Selection.Address, Type:=8)
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  If Not rng Is Nothing Then
    With Sheets("Auswertung")
      lngRow = 2
      Do While Application.CountA(.Range(.Cells(lngRow, 1), .Cells(lngRow, 12))) > 0
        .Cells(lngRow, 13) = ""
        bolCount = False
        For Each rngRow In rng.Rows
          For lngCol = 1 To 12
            If .Cells(lngRow, lngCol) <> "" Then
              bolCount = Application.CountIf(rngRow, .Cells(lngRow, lngCol))
            End If
          Next
          If bolCount Then .Cells(lngRow, 13) = .Cells(lngRow, 13) + 1
        Next
        lngRow = lngRow + 1
      Loop
    End With
  End If
  
  
  ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'countEntries'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
  End With
  
  Set rng = Nothing
  Set rngRow = Nothing
End Sub




« Gruß Sepp »

Anzeige
AW: @ Sepp: Zählenwenn
13.05.2012 09:53:20
Claudia
HAllo Sepp,
irgendwas stimmt nicht. Auch hier habe ich zu viele Treffer.
Habe mal eine abgespeckte und veränderte Datei hochgeladen.

Die Datei https://www.herber.de/bbs/user/80116.xls wurde aus Datenschutzgründen gelöscht


In der Datenbasis steht lediglich zwei Suchbegriffe (über drei Spalten verteilt). In der Auswertung habe ich die beiden Zeilen markiert, die einen Treffer bekommen müssten.
Dein Makro ist in der Datei hinterlegt.
Vielen Dank!
Liebe Grüße
Claudia
AW: @ Sepp: Zählenwenn
13.05.2012 10:23:05
Claudia
Hallo Sepp,
jetzt funktioniert es. Prima!
Vielen vielen Dank und noch einen schönen Sonntag!
Liebe Grüße
Claudia

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige