Mergen von Zeilen

Forumthread: Mergen von Zeilen

Mergen von Zeilen

20.01.2009 11:15:00

Zeilen

Hallo zusammen
Ich benötige dringend die Hilfe eines VBA Spezialisten.
Ich versuche seit einiger Zeit eine Liste so anzupassen, dass pro Vorgesetzter nur eine Zeile erscheint mit der Auflistung der PCs, Inventarnummern und Typen die in seinen Bereich gehören. Diese Informationen sollten am Ende der Tabelle angehängt werden.
Wenn ich nur PC und Inventarnummer kopiere, funktioniert das Makro. Sobald ich das Feld Typ anfüge kommt der folgende Fehler.
"Fehler beim Kompilieren; Falsche Anzahl an Argumenten oder ungültige Zuweisung der Eigenschaften"

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

...und wo ist der Code des Makros? (owT)

20.01.2009 11:59:09

RS
AW: Mergen von Zeilen

20.01.2009 12:57:24

Zeilen
AW: Range(x,y) mit zwei Parametern

20.01.2009 13:35:37

Erich
AW: Range(x,y) mit zwei Parametern

20.01.2009 17:08:00

Stefan

...und wo ist der Code des Makros? (owT)

20.01.2009 11:59:09

AW: Mergen von Zeilen

20.01.2009 12:57:24

Zeilen

Hallo RS
Anbei der Code fürs Makro!
Gruss
Stefan
Dim wks As Worksheet, lngZeile As Long, LastRow As Long
Dim varM_CSGUID, lngZeile2 As Long, spalte As Long
Set wks = ActiveSheet
Application.ScreenUpdating = False
With wks
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
For lngZeile = 2 To LastRow
If Not IsEmpty(.Cells(lngZeile, 6)) Then
spalte = 16 '1.Einfüge-Spalte
'Diese und die nächste Zeile wieder löschen, wenn "nur" die Inhalte aus _
den Zeilen mit nachfolgendem gleichen M_CSGUIDen kopiert werden sollen.
.Range(.Cells(lngZeile, 5), .Cells(lngZeile, 6), .Cells(lngZeile, 7)).Copy _
Destination:=.Cells(lngZeile, spalte)
spalte = spalte + 2
varM_CSGUID = .Cells(lngZeile, 6).Value
For lngZeile2 = lngZeile + 1 To LastRow
If varM_CSGUID = .Cells(lngZeile2, 6).Value Then
.Range(.Cells(lngZeile2, 5), .Cells(lngZeile2, 6), .Cells(lngZeile, 7)).Copy _
Destination:=.Cells(lngZeile, spalte)
.Rows(lngZeile2).Clear
'Spalte für nächsten Kopiervorgang
spalte = spalte + 2
End If
Next
End If
Next
'Leere zeilen Löschen
.Range(.Cells(2, 6), .Cells(LastRow, 6)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete _
shift:=xlShiftUp
End With
Application.ScreenUpdating = True
End Sub

AW: Range(x,y) mit zwei Parametern

20.01.2009 13:35:37

Erich

Hallo Stefan,
die erste und die vorletzte Zeile hier haben sich etwas geändert:


.Range(.Cells(lngZeile, 5), .Cells(lngZeile, 7)).Copy _
Destination:=.Cells(lngZeile, spalte)
spalte = spalte + 2
varM_CSGUID = .Cells(lngZeile, 6).Value
For lngZeile2 = lngZeile + 1 To LastRow
If varM_CSGUID = .Cells(lngZeile2, 6).Value Then
.Range(.Cells(lngZeile2, 5), .Cells(lngZeile, 7)).Copy _
Destination:=.Cells(lngZeile, spalte)

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Range(x,y) mit zwei Parametern

20.01.2009 17:08:00

Stefan

Hallo Erich, hallo RS
Merci! Hat super funktioniert. Habe noch einige Anpassungen vorgenommen und es läuft perfekt.
Nochmals Danke und eine schöne Woche.
Stefan


Sub ZeilenLöschen()
' Makro am 20.01.2009 von A607154 aufgezeichnet
Dim wks As Worksheet, lngZeile As Long, LastRow As Long
Dim varM_CSGUID, lngZeile2 As Long, spalte As Long
Set wks = ActiveSheet
Application.ScreenUpdating = False
With wks
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
For lngZeile = 2 To LastRow
If Not IsEmpty(.Cells(lngZeile, 17)) Then
spalte = 20 '1.Einfüge-Spalte
'Diese und die nächste Zeile wieder löschen, wenn "nur" die Inhalte aus _
den Zeilen mit nachfolgendem gleichen M_CSGUIDen kopiert werden sollen.
.Range(.Cells(lngZeile, 5), .Cells(lngZeile, 10)).Copy _
Destination:=.Cells(lngZeile, spalte)
spalte = spalte + 6
varM_CSGUID = .Cells(lngZeile, 17).Value
For lngZeile2 = lngZeile + 1 To LastRow
If varM_CSGUID = .Cells(lngZeile2, 17).Value Then
.Range(.Cells(lngZeile2, 5), .Cells(lngZeile2, 10)).Copy _
Destination:=.Cells(lngZeile, spalte)
.Rows(lngZeile2).Clear
'Spalte für nächsten Kopiervorgang
spalte = spalte + 6
End If
Next
End If
Next
'Leere zeilen Löschen
.Range(.Cells(2, 6), .Cells(LastRow, 6)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete  _
_
Shift:=xlShiftUp
End With
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

Forumthread: Mergen von Zeilen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread