Unieke cellen tellen met vba code

[danny147]

Beste,

Hoe kan ik met een code de unieke cellen tellen in kolom F
De formule heb ik maar niet de code --> uitkomst moet 14 zijn
Het aantal rijen zijn verschillend

 

[Cobbe]

Test deze eens:

Option Explicit
Function Tel_Unieke_Waarden(rngInput As Range) As Long
    Dim rngCel As Range
    Dim Unieke_Waarden As New Collection

    Application.Volatile

    On Error Resume Next
    For Each rngCel In rngInput
        Unieke_Waarden.Add rngCel.Value, CStr(rngCel.Value)
    Next rngCel
    Tel_Unieke_Waarden = Unieke_Waarden.Count
End Function

Bron: SpreadSheet Solutions

 

[HSV]

of:

Sub hsv()
Dim sn, i As Long
sn = Columns(6).SpecialCells(2)
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(sn)
      .Item(sn(i, 1)) = ""
    Next i
   MsgBox .Count
  End With
End Sub

 

[danny147]

Beste,

Nu moet ik de uitkomst wegschrijven naar een andere plaats

Aantal = Count
Sheets("Statistieken").Range("U7").End(xlToLeft).Offset(0, 1) = aantal

Aantal =count gaat niet ?

 

[HSV]

Op welk bericht reageer je Danny?

 

[danny147]

Beste HSV,

Op dat van jou,
Wil count als aantal hebben.
Om daarna de uitkomst weg te schrijven naar ander tabblad.

 

[HSV]

Denk aan de punt.

[SIZE=2]Sheets("Statistieken").Range("U7").End(xlToLeft).Offset(0, 1)= [SIZE=7][COLOR=#ff0000].[/COLOR][/SIZE]count[/SIZE]

 

[danny147]

Beste HSV,

Wederom bedankt, maar heb mijn fout ingezien.
Heb het stukje code achter End With geplaatst, daarom deed hij het niet.

 

[danny147]

Beste,

Nu komt volgende probleem voor:

Wil filteren in kolom 9 op <>*BGE*, en daarna de unieke waarden tellen in kolom 6
Heb gezien dat hij dan ook de onzichtbare rijen ook mee telt bij de unieke waarden
Voorlopig heb ik deze code gebruikt om mij uit de slag te trekken.
Kan deze bewerkt worden zonder extra tabblad te gebruiken ?

Sub Aantal_Orders()
    i = "Output"
    ii = "Blad1"
    With ThisWorkbook.Sheets(i)
    With .Cells.CurrentRegion
    If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
    .AutoFilter 9, Criteria1:="<>*BGE"
    Columns("F:F").Copy Destination:=Worksheets(ii).Range("A1")
    Worksheets(ii).Select
    Range("$A$1:$A$5000").RemoveDuplicates Columns:=1, Header:=xlYes
    Aantal = Range("A7000").End(xlUp).Row
    Sheets("Statistieken").Range("U4").End(xlToLeft).Offset(0, 1) = Aantal - 1
    Worksheets(ii).Columns("A:A").Delete
    Sheets(i).ShowAllData
    Sheets(i).Activate
    End With
    End With
End Sub

 

[HSV]

Misschien met een formule?

=AANTAL(ALS(INTERVAL(ALS(SUBTOTAAL(9;VERSCHUIVING(I2;RIJ(I2:I7000)-2;));I2:I7000);I2:I7000);I2:I7000))-1

 

[danny147]

Beste HSV,

Zal deze eens uittesten, maar wacht nog wat af of iemand deze met de code kan doen werken.

 

[HSV]

Zoiets?

Sub Aantal_Orders()
    With ThisWorkbook.Sheets("Output")
       If .AutoFilterMode Then .AutoFilterMode = False
          .Cells(1).CurrentRegion.AutoFilter 9, Criteria1:="<>*BGE"
          sn = .Columns(6).SpecialCells(2)
             Set d = CreateObject("scripting.dictionary")
                For i = 2 To UBound(sn)
                 If Not .Rows(i).Hidden Then d.Item(sn(i, 1)) = ""
                Next i
         Sheets("Statistieken").Range("U4").End(xlToLeft).Offset(, 1) = d.Count
       .ShowAllData
    End With
End Sub

 

[danny147]

Beste HSV,

Een weekje met verlof daarom de late reactie.
Deze werkt prima

Bedankt alweer :d