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

Duplikate in Ausgabe

Duplikate in Ausgabe
23.11.2015 14:23:57
alifa
Hallo,
kann man schon bei der Ausgabe Duplikate vermeiden? Hier ein Beispiel(Makro). Jedes Wort sollte nur einmal auftreten. Im Prinzip sollte der Aufbau nicht wesentlich geändert werden. Es geht nur um die Ausgabe. Danke im Voraus.
https://www.herber.de/bbs/user/101747.xlsm
Gruß, Erhard

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Duplikate in Ausgabe
23.11.2015 14:34:18
Rudi
Hallo,
prüfe einfach, ob s2 noch nicht vorkommt.
If application.countif(columns(1),s2))=0 then
'mach was
end if
Gruß
Rudi

AW: Duplikate in Ausgabe
24.11.2015 08:11:17
Alifa
Hallo,
das klappt leider nicht. Wie kann ich "Scripting.Dictionary" anwenden, damit bei der Ausgabe von s2 keine Duplikate vorkommen?
Gruß, Erhard

AW: Duplikate in Ausgabe
24.11.2015 09:54:34
Rudi
Hallo,
so?
Sub Test23_11_15()
Dim a1, b1, c1
Dim d1, d2, d3, d4, e1, e3, e4, f1, f2, f3, f4
Dim z%, t!, k, v, s2
Dim objDic As Object
Set objDic = CreateObject("scripting.dictionary")
t = Timer
Cells.ClearContents
k = Array("B", "D", "F", "G", "H")
v = Array("A", "E", "I")
For Each d1 In k
For Each d2 In k
For Each d3 In v
For Each d4 In k
If BuchstabeInZahl(d1) + BuchstabeInZahl(d2) + BuchstabeInZahl(d3) + BuchstabeInZahl( _
d4) = 21 Then
For Each e1 In k
For Each e3 In v
For Each e4 In v
If BuchstabeInZahl(e1) + BuchstabeInZahl(e3) + BuchstabeInZahl(e4) = 13 Then
For Each f1 In k
For Each f2 In k
For Each f3 In k
For Each f4 In k
If BuchstabeInZahl(f1) + BuchstabeInZahl(f2) + BuchstabeInZahl(f3) + _
BuchstabeInZahl(f4) = 24 Then
s2 = d4 & e4 & f4
If Application.CheckSpelling(s2) Then                              _
objDic(s2) = 0
If z = 1000 Then
Cells(1, 1).Resize(objDic.Count) = WorksheetFunction. _
Transpose(objDic.keys)
Exit Sub
End If
z = z + 1
Columns.AutoFit
'MsgBox Round(Timer - t, 1)
End If: End If: Next: Next: Next: Next: End If: Next: Next: Next:  _
End If: Next: Next: Next: Next d1
MsgBox Round(Timer - t, 1)
End Sub

Gruß
Rudi

Anzeige
AW: Duplikate in Ausgabe
24.11.2015 13:13:17
Alifa
Hallo Rudi,
vielen Dank! Das passt.
Viele Grüsse, Erhard

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige