Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 16:33:24
Worksheets variable
18.04.2024 15:53:31
In Outlook (Exchange) Serientermin erstellen
18.04.2024 15:16:20
VBA Suchen, Kopieren, Einfügen
18.04.2024 15:16:07
Verschieben von Daten um bestimmte Zeilen nach unten
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
828to832
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
828to832
828to832
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Tabelle durchsuchen

Tabelle durchsuchen
24.12.2006 14:47:35
Peter
Hallo Zusammen,
möchte ein komplettes Tabellenblatt Namens "Quelldaten" nach Zellen durchsuchen, die kursiv formariet und in eine Tabelle Namens "Ergebnis" übernehmen. Doppelte Beriffe sollen dabei nur einmal in die Tabelle "Ergebnis" übernommen werden, so das jeder Begiff nur einmal in der Tabelle "Ergebnis" vorkommt. Die Daten aus "Quelldaten" sollen dann in "Ergebnis" so ab Zeile 8 untereinander aufgelistet werden. Kann mir hierfür jeman ein VBA-Code schreiben?
Ich hoffe das mir jemand helfen kann.

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

Betreff
Datum
Anwender
Anzeige
AW: Tabelle durchsuchen
24.12.2006 16:32:33
Herby
Hallo Peter,
nachstehendes Makro kopiert dir alle Zellen sofern Kursiv formatiert, aus dem Bereich A1:D100 (ggf. anpassen auf A1:IV65536) in das Blatt Ergebnis in Spalte A.
Doppelte Begriffe müsstest Du ggf. über Daten - Filter - Spezialfilter - keine Dublikate danach noch herausfiltern.
Bei Bedarf kann man das auch per Makro automatisieren.

Sub Bescherung()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim Zelle As Range
Dim i As Long
Set wks1 = Worksheets("Quelldaten")
Set wks2 = Worksheets("Ergebnis")
i = 7
For Each Zelle In Range("A1:D100")
If wks1.Cells(Zelle.Row, Zelle.Column).Font.Italic = True Then
i = i + 1
wks2.Cells(i, 1) = Zelle
End If
Next
End Sub

Frohes Fest
Herby
Anzeige
AW: Tabelle durchsuchen
24.12.2006 20:44:17
Peter
Hallo,
danke das Makro funktioniert einwandfrei, aber es wäre wesendlich einfacher wenn man das herausfiltern der doppelten Begriffe mit dem Makro machen könnte.
AW: Tabelle durchsuchen
25.12.2006 12:06:16
Herby
Hallo Peter,
hast recht, warum soll man es mit der Hand machen wenns per Makro automatisch geht.
Das Makro Bescherung ruft am Schluss noch das Makro Dublikate auf. Dieses filtert über den Spezialfilter die Dublikate raus. Dazu braucht es aber eine "Hilfsspalte" diese kannst du irgendwohin legen, wo es nicht stört. Im Makro ist es aktuell die Spalte B.
Nach dem Durchlauf wird diese Spalte wieder gesäubert.
Viele GRüße
Herby

Sub Bescherung()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim Zelle As Range
Dim i As Long
Set wks1 = Worksheets("Quelldaten")
Set wks2 = Worksheets("Ergebnis")
i = 7
For Each Zelle In wks1.Range("A1:D100")
If wks1.Cells(Zelle.Row, Zelle.Column).Font.Italic = True Then
i = i + 1
wks2.Cells(i, 1) = Zelle
End If
Next
Set wks1 = Nothing
Set wks2 = Nothing
dublikate
End Sub



Sub dublikate()
Dim wks1 As Worksheet
Dim Bereich As Range
Dim lZ1 As Long, lZ2 As Long
Set wks1 = Worksheets("Ergebnis")
lZ1 = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
Set Bereich = wks1.Range("A8:A" & lZ1)
'Bereich.AdvancedFilter Action:=xlFilterInPlace, criteriaRange:=Bereich, unique:=True
Bereich.AdvancedFilter Action:=xlFilterCopy, criteriaRange:=Bereich, CopyToRange:=wks1.Range("B8"), unique:=True
wks1.Range("A8:A" & lZ1).Clear
lZ2 = wks1.Cells(wks1.Rows.Count, 2).End(xlUp).Row
wks1.Range("B8:B" & lZ2).Copy wks1.Range("A8")
wks1.Range("B8:B" & lZ1).Clear
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige