Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
23.04.2024 17:00:22
Summe und Ausgabe
23.04.2024 16:27:34
Excel Starthinweis - Arbeitsmappenleistung überprüfen ...
23.04.2024 16:15:16
Mittels VBA vordefinierte Kommentare in Zellen einfügen?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1236to1240
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
1236to1240
1236to1240
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zeilen kopieren, wenn ..

Zeilen kopieren, wenn ..
Anna
Hallo Excel-Profis,
ich fand im Archiv nichts passendes, was meinen Wunsch abdeckt.
Von einem Fremdsystem habe ich die Tabelle1 in der ca 500 Datensätze sind. (500 Zeilen).
In der Spalte D (4. Spalte) steckt eine Zahl oder ein Begriff ( z.B. 1250 oder BA17, oder 0001 etc.).
Excel soll nun von jeder Sorte ( Spalte D) je einen Datensatz in Tabelle2 übertragen, so dass aber in Tabelle2 nur jeweils die erste gefundene Zeile kopieren, so dass in Tabelle2 in Spalte D keine doppelten Sätze existieren.
Wichtig:
in Tabelle 1 und in Tabelle 2 sind die ersten 4 Zeilen, Titel, Datum, etc..
Diese Zeilen also von diesem Kopiermechanismus ausschliessen.
Zusatz (nur wenn so etwas geht) - "Nice to have":
in der Tabelle1 sind maximum 30 Spalten belegt (AD).
es wäre natürlich super, wenn in der Spalte AE in Tabelle 2 stehen würde, aus welcher Zeile (aus Tabelle1) der Datensatz stamm.
z.B. in Tabelle2, AD17: "10" (=10. Zeile, Tabelle1).
Danke für einen kleinen Code.
Anna

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

Betreff
Benutzer
Anzeige
AW: Zeilen kopieren, wenn ..
15.11.2011 14:14:26
Rudi
Hallo,
das sollte es bringen: 
Sub kopieren()
Dim lRow As Long, rngCopy As Range, oDict As Object
Set oDict = CreateObject("Scripting.Dictionary")
With Sheets("Tabelle1")
For lRow = 5 To Cells(Rows.Count, 4).End(xlUp).Row
If Not oDict.exists(.Cells(lRow, 4).Value) Then
oDict(.Cells(lRow, 4).Value) = lRow
If rngCopy Is Nothing Then
Set rngCopy = .Cells(lRow, 1)
Else
Set rngCopy = Union(rngCopy, .Cells(lRow, 1))
End If
End If
Next
End With
If Not rngCopy Is Nothing Then
rngCopy.EntireRow.Copy Sheets(2).Cells(1, 1)
With Sheets(2)
For lRow = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
.Cells(lRow, 31) = oDict(.Cells(lRow, 4).Value)
Next lRow
End With
End If
End Sub

Gruß
Rudi
Anzeige
AW: Zeilen kopieren, wenn ..
15.11.2011 15:12:59
Anna
Hallo Rudi,
leider kann ich wirklich kein VBA.
Bereits bin ich aber angemeldet, und ich will mich nach dem Kursus auch damit beschäftigen.
Der kleine Fehler in meinem Text oder in Deinem Code liegt noch dort, dass in der Tabelle2 auf der Zeile1 mit dem Schreiben begonnen wird, statt auch auf Zeile 5.
Danke
Anna
AW: Zeilen kopieren, wenn ..
15.11.2011 15:13:15
Anna
Hallo Rudi,
leider kann ich wirklich kein VBA.
Bereits bin ich aber angemeldet, und ich will mich nach dem Kursus auch damit beschäftigen.
Der kleine Fehler in meinem Text oder in Deinem Code liegt noch dort, dass in der Tabelle2 auf der Zeile1 mit dem Schreiben begonnen wird, statt auch auf Zeile 5.
Danke
Anna
Anzeige
AW: Zeilen kopieren, wenn ..
15.11.2011 16:21:24
Rudi
Hallo,
dann so: 
Sub kopieren()
Dim lRow As Long, rngCopy As Range, oDict As Object
Set oDict = CreateObject("Scripting.Dictionary")
With Sheets("Tabelle1")
For lRow = 5 To Cells(Rows.Count, 4).End(xlUp).Row
If Not oDict.exists(.Cells(lRow, 4).Value) Then
oDict(.Cells(lRow, 4).Value) = lRow
If rngCopy Is Nothing Then
Set rngCopy = .Cells(lRow, 1)
Else
Set rngCopy = Union(rngCopy, .Cells(lRow, 1))
End If
End If
Next
End With
If Not rngCopy Is Nothing Then
rngCopy.EntireRow.Copy Sheets(2).Cells(5, 1)
With Sheets(2)
For lRow = 5 To .Cells(Rows.Count, 4).End(xlUp).Row
.Cells(lRow, 31) = oDict(.Cells(lRow, 4).Value)
Next lRow
End With
End If
End Sub

Gruß
Rudi
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige