Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1480to1484
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
VBA - Liste erstellen
10.03.2016 08:24:31
Brando
Hallo,
ich habe folgendes Makro. Es kopiert aus einer Tabelle 2 eine Liste in Tabelle 1 und sortiert dabei die doppelten aus. Funktioniert gut!
Problem bei dem Kopieren sollen neben den doppelt vorkommenden Texten und leeren Zellen, auch Zellen mit dem Text *tisch nicht berücksichtigt werden.
Da meine VBA Kenntnisse schwach sind, wäre ich hier für Hilfe dankbar!

Sub Makro1()
Dim test
Dim Dic As Object
Dim A As Long
Set Dic = CreateObject("Scripting.Dictionary")
Worksheets("Tabelle1").Range("B117:B150").ClearContents
'Tabellenname anpassen
With Sheets("Tabelle2")
'Komplette Spalte DN
test = .Range("DN2", IIf(IsEmpty(.Cells(.Rows.Count, 118)), .Cells(.Rows.Count, 118).End(  _
_xlUp), .Cells(.Rows.Count, 118)))
'Liste erstellen ohne doppelte
For A = 1 To UBound(test)
If test(A, 1)  "" Then
Dic(test(A, 1)) = 0
End If
Next A
'Daten einfügen
ActiveWorkbook.Sheets("Tabelle1").Range("B117").Resize(Dic.Count) = Application.Transpose(Dic. _
keys)
End With
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: VBA - Liste erstellen
10.03.2016 09:26:54
Daniel
Hi
die Prüfung kannst du so einbauen:
...
For A = 1 to Ubound(test, 1)
If test(A, 1)  "" Then
if Not test(A, 1) like "*tisch" Then
Dic(test(A, 1)) = 0
End If
End If
Next A
...

Gruß Daniel

AW: VBA - Liste erstellen
10.03.2016 10:45:23
Brando
Perfekt Danke!!!

AW: VBA - Liste erstellen für Excel-Profi
10.03.2016 09:41:02
Daniel
Bei deinem Level würde ich dir vielleicht folgende Programmierung vorschlagen:

With Sheets("Tabelle2")
.Range("DN2:DN" & .Cells(.Rows.Count, "DN").End(xlup).row).copy
End with
Sheets("Tabelle1").Select
ActiveSheet.Cells(117, 2).PasteSpecial xlpastevalues
With Selection
.Replace "*tisch", "", xlwhole
.RemoveDuplicates 1, xlno
on Error Resume Next
.SpecialCells(xlcelltypeblanks).Delete Shift:=xlup
on Error Goto 0
End With
Damit stellst du die Methode nach, mit der du das ganze ohne VBA von Hand lösen würdest, was für dich den Vorteil hätte, dass du die benötigten Befehle mit dem Recorder aufzeichnen kannst und nicht auf VBA-Spezialwissen zurückgreifen musst.
Gruß Daniel
Anzeige

79 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige