Anzahl gleicher Begriffe im Array

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Ich steh grad etwas auf dem Schlauch, sollte vielleicht mal Feierabend machen :D
Könntest du mir evtl. ein Beispiel machen, wie du den Code mit dem ReDim Preserve aufbaust? Das wäre echt super, ich habe die Funktion noch nie verwendet.
Im folgenden findest du meinen Code, wie ich meine Arrays befülle:
Dim strEmp01 As String ' Variable Mitarbeiter 1
Dim strEmp02 As String ' Variable Mitarbeiter 2
Dim strEmp03 As String ' Variable Mitarbeiter 3
Dim strEmp04 As String ' Variable Mitarbeiter 4
Dim varGetWork01() As Variant 'Array Mitarbeiter 1
Dim varGetWork02() As Variant 'Array Mitarbeiter 2
Dim varGetWork03() As Variant 'Array Mitarbeiter 3
Dim varGetWork04() As Variant 'Array Mitarbeiter 4
Dim intCountRow As Integer ' Zähler Reihe
Dim intColEmp As Integer ' Spalte Bearbeiter
Dim intRowTask As Integer ' Spalte Aufgabenbezeichnung
Dim intSizeArr01 As Integer ' ArraySize Aufgaben M1
Dim intSizeArr02 As Integer ' ArraySize Aufgaben M2
Dim intSizeArr03 As Integer ' ArraySize Aufgaben M3
Dim intSizeArr04 As Integer ' ArraySize Aufgaben M4
Dim adrName As Range ' Definition Range für Suche
Dim intFullRow As Integer 'Anzahl beschriebener Zeilen
Dim a, b, c, d As Integer 'Zähler für die Arrays
Worksheets("Archiv").Activate
Set adrName = Worksheets("Archiv").Range("F:F")
strEmp01 = "Mitarbeiter1"
strEmp02 = "Mitarbeiter2"
strEmp03 = "Mitarbeiter3"
strEmp04 = "Mitarbeiter4"
intCountRow = 5 ' Startzeile
intColEmp = 6 ' Reihe Mitarbeitername
intRowTask = 1 ' Zeile der Aufgabe
a = 0
b = 0
c = 0
d = 0
intSizeArr01 = Application.WorksheetFunction.CountIf(adrName, strEmp01) - 1 ' Arraygröße Employee01 festlegen
intSizeArr02 = Application.WorksheetFunction.CountIf(adrName, strEmp02) - 1 ' Arraygröße Employee02 festlegen
intSizeArr03 = Application.WorksheetFunction.CountIf(adrName, strEmp03) - 1 ' Arraygröße Employee03 festlegen
intSizeArr04 = Application.WorksheetFunction.CountIf(adrName, strEmp04) - 1 ' Arraygröße Employee04 festlegen
intFullRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ReDim varGetWork01(intSizeArr01)
ReDim varGetWork02(intSizeArr02)
ReDim varGetWork03(intSizeArr03)
ReDim varGetWork04(intSizeArr04)
For intCountRow = 5 To intFullRow
If Cells(intCountRow, intColEmp).Value = strEmp01 Then
'Array1 füllen
varGetWork01(a) = Cells(intCountRow, 1).Value
a = a + 1
ElseIf Cells(intCountRow, intColEmp).Value = strEmp02 Then
'Array2 füllen
varGetWork02(b) = Cells(intCountRow, 1).Value
b = b + 1
ElseIf Cells(intCountRow, intColEmp).Value = strEmp03 Then
'Array3 füllen
varGetWork03(c) = Cells(intCountRow, 1).Value
c = c + 1
ElseIf Cells(intCountRow, intColEmp).Value = strEmp04 Then
'Array4 füllen
varGetWork04(d) = Cells(intCountRow, 1).Value
d = d + 1
End If
Next
End Sub
Gruß Andi

Hi Andi,
echt jetzt?!
Dein Makro TaskDistribution, in dem deine dynamischen Arrays gebildet werden, funktioniert nur...
...wenn in Tabelle "Archiv", in Spalte F, Einträge (MA-Namen) vorhanden sind
In deiner Bsp-Datei, in "Archiv", ist Spalte F = LEER!
Spalte F wurde mit einer Datengültigkeitsliste belegt; Quelle = Archiv!$M$4:$M$8
...aber diese Zellen, $M$4:$M$8, sind auch...LEER!
Ok, ich hab nun...
a) in $M$4:$M$8 = M1 bis M5 eingetragen
b) in "Archiv", Spalte F,in den Zeilen 5 - 13 wahlfreie Einträge von M1 bis M4 manuell eingetragen
Jetzt starte ich dein Makro TaskDistribution
Das Makro läuft durch bis zur Zeile


For intCountRow = 5 To intFullRow

alles, was zwischen For + Next ist, wird nicht durchgeführt!
Denn intFullRow ergibt sich aus


intFullRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

aber aber aber!!!!...wer ahnt es schon?...Tabelle "Archiv", Bereich A5:B32 IST LEER!!!!...(außer meine 5 manuellen Einträge in Spalte F)
Sorry Andi, aber ich kanns nich anders formulieren:
Denk mit! Und sei nicht so faul, dass du nur die vielleicht originalen Zellinhalte löschst - füll die Tabelle auch wieder mit genügend Bsp-Werten auf!
Viel Spaß + Erfolg für den nächsten Helfer...ich mag nich mehr.
Ciao
Thorsten

Dim ArrA, ArrB, WF ArrA = Array("AAA", "BBB", "AAA", "CCC") Set WF = WorksheetFunction ArrB = WF.Transpose(WF.Unique(WF.Transpose(ArrA))) 'oder Cells(1, 1).Resize(UBound(ArrA)) = WF.Unique(WF.Transpose(ArrA))

dim dic as Dictionary dim Zelle as Range set dic = Createobject("Scripting.Dictionary") For Each Zelle in Cells(1, 1).CurrentRegion.Columns(1) dic(Zelle.Value) = dic(Zelle.Value) next Cells(1, 2).Resize(dic.Count) = Worksheetfunction.Transpose(dic.Keys) Cells(1, 3).Resize(dic.Count) = Worksheetfunction.Transpose(dic.Items)

Beliebteste Forumthreads (12 Monate)

Anzahl gleicher Begriffe im Array

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread