Zeilen suchen und kopieren

Forumthread: Zeilen suchen und kopieren

11.02.2008 10:04:00

Uwe

Hallo,
ich habe folgendes Problem: Habe in Spalte A Daten die mit e.... und in B mit d.... anfangen. Leider sind ein paar nicht sortiert, stehen also untereinander und sollen in die höhere Spalte kopiert werden.
Beispiel:
Wenn
A B
e Vokabel
d Vokabel
dann soll
A B
e Vokabel d Vokabel
...also die Zelle in der das d steht soll eins höher in Spalte B kopiert werden.
Danke für Eure Vorschläge!
Uwe

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Nachfrage

11.02.2008 10:33:30

Chris
AW: Nachfrage

11.02.2008 10:40:09

Uwe
AW: Nachfrage

11.02.2008 10:52:00

Chris
AW: Nachfrage

11.02.2008 11:32:00

Chris
AW: kleine Nachbesserung

11.02.2008 12:17:00

Chris

AW: Nachfrage

11.02.2008 10:33:30

Chris

Servus,
wohin die in Spalte B kopiert werden ist egal? Und was soll mit den äquivalenten in Spalte A passieren (Löschen der Zelle?).
Stehen in Spalte B auch Werte daneben?
Gruß
Chris

AW: Nachfrage

11.02.2008 10:40:09

Uwe

Hi Chris,
die Zelle die d... enthält soll eine Zeile höher (wo das e steht) in Spalte B verschoben werden und die leere Zeile gelöscht werden.
Beispiel
A B
e 1
d 1
e 2 d 2
e 3
d 3
soll so aussehen
A B
e 1 e 1
e 2 d 2
e 3 d3
Danke

AW: Nachfrage

11.02.2008 10:52:00

Chris

Servus,
das hab ich schon verstanden, aber was mach ich wenn das so aussieht:
A B
e1 d1
d2
e2 d3
...
soll dann so aussehen ?:
A B
e1 d1
e2 d3
... d2
Gruß
chris

AW: Nachfrage

11.02.2008 11:32:00

Chris

Servus,
probiers mal so:


Sub test()
Dim rng As Range, letzte As Long
letzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
Application.ScreenUpdating = False
Columns(1).Insert
With Range("A1:A" & letzte)
.FormulaR1C1 = "=IF(LEFT(RC2,1)=""d"",TRUE,ROW())"
.Formula = .Value
For Each rng In .SpecialCells(xlCellTypeConstants, 4)
If rng.Offset(-1, 2) = "" Then
rng.Offset(-1, 2) = rng.Offset(0, 1)
Else
Range("C65536").End(xlUp).Offset(1, 0) = rng.Offset(0, 1)
End If
Next rng
.SpecialCells(xlCellTypeConstants, 4).Offset(0, 1).Delete Shift:=xlUp
With Range("C:C")
.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
.EntireColumn.Delete
End With
Application.ScreenUpdating = True
End Sub

Gruß
Chris

AW: kleine Nachbesserung

11.02.2008 12:17:00

Chris


Sub test()
Dim rng As Range, letzte As Long
letzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
Application.ScreenUpdating = False
Columns(1).Insert
With Range("A1:A" & letzte)
.FormulaR1C1 = "=IF(LEFT(RC2,1)=""d"",TRUE,ROW())"
.Formula = .Value
On Error Resume Next
For Each rng In .SpecialCells(xlCellTypeConstants, 4)
If rng.Offset(-1, 2) = "" Then
rng.Offset(-1, 2) = rng.Offset(0, 1)
Else
Range("C65536").End(xlUp).Offset(1, 0) = rng.Offset(0, 1)
End If
Next rng
.SpecialCells(xlCellTypeConstants, 4).Offset(0, 1).Delete Shift:=xlUp
With Range("C:C")
.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
On Error GoTo 0
.EntireColumn.Delete
End With
Application.ScreenUpdating = True
End Sub

Gruß
Chris

Beliebteste Forumthreads (12 Monate)

Forumthread: Zeilen suchen und kopieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread