Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1092to1096
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

frage zu Array zählen("Scripting.dictionary") Join

frage zu Array zählen("Scripting.dictionary") Join
chris
Hallo VBA Profis,
wünsche allen einen schönen Tag.
Habe eine frage und hoffe ihr könnt mir weiterhelfen.
Wo ich mir aber sicher bin.
ich habe unten einMakro das ich gerne erweitern möchte.
ich habe in Spalte J verschiedene namen stehen.
Alf
Robert
usw..
mit dem angefügten Makro füge ich in die Variable test alle Namen nur einmal ein.
So das dann "test" ein Array wird.
Was ich aber jetzt nicht schaffe bzw nicht weiß wie ich es am einfachsten machen kann ist folgendes.
Zu den Namen in spalte J habe ich in Spalte D Werte stehen.
Meistens nur ein "x"
Ich möchte jetzt das mir mein Makro alle namen einmal ausgibt und dazu die Anzahl derer in denen sich kein x befindet.
beispiel so:
x Alf
x Robert
x Alf
Robert
Alf
x kai
Alf
Also würde die msgbox lauten
"
Alf = 2
Robert = 1
"
Kai würde nicht erscheinen weil er nur einmal vorhanden ist und in spalte D kein x steht
'Mein makro bis jetzt
Option Explicit
Sub start()
Dim scr
Dim x As Integer
Dim Zelle As Range
Dim machs
Dim test
Set scr = CreateObject("Scripting.dictionary")
For x = 1 To Cells(Rows.Count, 10).End(xlUp).Row
scr(Cells(x, 10).Text) = scr(Cells(x, 10).Text)
Next
machs = Join(scr.keys, ", ")
test = Split(machs, ",")
End Sub

Vielen Dank für eure Hilfe !
gruß chris

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: frage zu Array zählen("Scripting.dictionary") Join
04.08.2009 15:13:46
MichaV
Hallo,
hab mich noch nie mit scripting.dictionary beschäftigt, scheint ganz net zu sein.
Option Explicit
Sub start()
Dim scr
Dim x As Integer
Dim Zelle As Range
Dim test
Set scr = CreateObject("Scripting.dictionary")
For x = 1 To Cells(Rows.Count, 10).End(xlUp).Row
If Cells(x, 10).Text  "" And Cells(x, 2).Text = "x" Then
If scr.exists(Cells(x, 10).Text) Then
scr(Cells(x, 10).Text) = scr(Cells(x, 10).Text) + 1
Else
scr.Add Cells(x, 10).Text, "1"
End If
End If
Next
For Each test In scr.keys
MsgBox test & "=" & scr(test)
Next
End Sub
Gruß- Micha
PS: http://msdn.microsoft.com/en-us/library/x4k5wbx4(VS.85).aspx
Anzeige
Nachtrag
04.08.2009 15:18:07
MichaV
im Mittelteil reicht:
For x = 1 To Cells(Rows.Count, 10).End(xlUp).Row
If Cells(x, 10).Text "" And Cells(x, 2).Text = "x" Then
scr(Cells(x, 10).Text) = scr(Cells(x, 10).Text) + 1
End If
Next
...sehr sehr nett.
AW: Nachtrag
04.08.2009 15:53:15
chris
Danke Micha !
Klappt

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige