Funktion CountIf

Bild

Betrifft: Funktion CountIf
von: Andi...
Geschrieben am: 12.08.2015 15:36:15

Hallo,
Ich möchte folgendes Problem lösen: in der Tabelle stehen in Spalte 5 die Auftragsnummern, diese sollen verglichen werden und wenn eine Auftragsnummer mehrmals vorkommt, dann soll „WAHR“ und wenn diese nur einmal vorkommt, dann soll „Falsch“ in Spalte 8 ausgegeben werden. Momentan habe ich das mit der Funktion "Zählenwenn" gelöst:
=Zählenwenn(E2:E$10000;E2)>1
Das Funktioniert auch ganz gut nur es dauert sehr lange, wenn alle Daten aktualisiert werden und alle Formeln neu berechnet werden.
Nun möchte ich das Ganze mit VBA lösen. Ich habe hierzu auch schon einen Code aber mit diesem dauert die Prozedur noch länger:

Sub Vergleich()
Dim Hilfstabelle As Worksheet
Dim i As Long
Dim j As Long
Dim werT As Long
Dim Bereich As Range
Set Hilfstabelle = ThisWorkbook.Worksheets("Hilfstabelle")
j = Hilfstabelle.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Hilfstabelle.Cells(Rows.Count, 5).End(xlUp).Row
    If Application.WorksheetFunction.CountIf(Range(Cells(i, 5), Cells(j, 5)), Cells(i, 5)) <= 1  _
Then
        Cells(i, 8) = False
    Else
        Cells(i, 8) = True
        
    End If
Next i
           
End Sub
Habt Ihr vielleicht eine Idee wie man den Code anpassen müsste, damit dieser schneller läuft?
Viele Grüße
Andi

Bild

Betrifft: AW: Funktion CountIf
von: Andi...
Geschrieben am: 12.08.2015 15:39:33
Hier noch eine kurze Version der Tabelle:
https://www.herber.de/bbs/user/99516.xlsx

Bild

Betrifft: AW: Funktion CountIf
von: Rudi Maintaire
Geschrieben am: 12.08.2015 16:02:10
Hallo,
reich 0,1 Sek. für 20000 Datensätze?

Sub AuftragsAnzahl()
  Dim vArr, i As Long
  Dim oCount As Object
  Set oCount = CreateObject("scripting.dictionary")
  vArr = Range(Cells(2, 5), Cells(Rows.Count, 5).End(xlUp))
  For i = 1 To UBound(vArr)
    oCount(vArr(i, 1)) = oCount(vArr(i, 1)) + 1
  Next
  For i = 1 To UBound(vArr)
    vArr(i, 1) = oCount(vArr(i, 1)) > 1
  Next
  Cells(2, 8).Resize(UBound(vArr)) = vArr
End Sub
Wenn du die Anzahl willst, lasse einfach > 1 weg
Gruß
Rudi

Bild

Betrifft: AW: Funktion CountIf
von: Andi...
Geschrieben am: 12.08.2015 16:21:16
Hallo Rudi,
ja 0,1 Sek ist ausreichend :-)
Vielen Dank, der Code läuft super.
Grüße
Andi

Bild

Betrifft: AW: Funktion CountIf
von: Andi...
Geschrieben am: 13.08.2015 07:56:11
Hallo Rudi,
ein Frage hätte ich noch, lässt sich der Code auch so anpassen, dass wenn der Auftrag zum ersten mal vorkommt "Falsch" und bei allen weiteren gleichen Auftragsnummern "Wahr" ausgegeben wird?
Grüße
Andi

Bild

Betrifft: AW: Funktion CountIf
von: Rudi Maintaire
Geschrieben am: 13.08.2015 10:30:07
Hallo,
sicher geht das.

Sub AuftragsAnzahl()
  Dim vArr, i As Long
  Dim oCount As Object, oCountA As Object
  Set oCount = CreateObject("scripting.dictionary")
  Set oCountA = CreateObject("scripting.dictionary")
  vArr = Range(Cells(2, 5), Cells(Rows.Count, 5).End(xlUp))
  For i = 1 To UBound(vArr)
    oCount(vArr(i, 1)) = oCount(vArr(i, 1)) + 1
  Next
  For i = 1 To UBound(vArr)
    If oCountA.exists(vArr(i, 1)) Then
      vArr(i, 1) = oCount(vArr(i, 1)) > 1
    Else
      oCountA(vArr(i, 1)) = 0
      vArr(i, 1) = False
    End If
  Next
  Cells(2, 8).Resize(UBound(vArr)) = vArr
End Sub

Gruß
Rudi

Bild

Betrifft: AW: Funktion CountIf
von: Andi...
Geschrieben am: 13.08.2015 14:43:07
Hallo Rudi,
Vielen Dank, funktioniert einwandfrei.
Gruß
Andi

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Funktion CountIf"