Nur aktive Zeilen automatisch zusammenführen

Forumthread: Nur aktive Zeilen automatisch zusammenführen

18.07.2024 08:06:20

TimHo

Moin,

ich habe ein Makro aufgenommen um unteranderem in Spalte Z, die Spalten D2 und E2 zusammenzuführen.
Hier sollen die beiden Werte noch mit einem Komma und Leerzeichen getrennt werden.
Das funktioniert auch soweit gut, nur weiß ich noch nicht wie ich das auf die aktiven Zeilen
begenzen kann.
Die Tabelle ist z.B. mal 40 Zeilen lang und mal 150 Zeilen lang.
Das habe ich bisher leider nicht hinbekommen.
Könnt Ihr mir da weiterhelfen?
Vielen DAnk schon einmal !



Sub Taxmetall()

'

' Taxmetall Makro

' - fügt erste Zeile ein und füllt diese Teilweise aus - fasst Benennung1 und Benennung 2 zusammen

'



'

    Rows("2:2").Select

    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Range("A2").Select

    ActiveCell.FormulaR1C1 = "0"

    Range("C2").Select

    ActiveCell.FormulaR1C1 = "1"

    Range("F2").Select

    ActiveCell.FormulaR1C1 = "ANLAGEN"

    Range("G2").Select

    ActiveCell.FormulaR1C1 = "Stück"

    Range("A2").Select

    With Selection

        .HorizontalAlignment = xlRight

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Range("C2").Select

    With Selection

        .HorizontalAlignment = xlLeft

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Range("F2").Select

    With Selection

        .HorizontalAlignment = xlLeft

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Range("G2").Select

    With Selection

        .HorizontalAlignment = xlLeft

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Range("V2").Select

    With Selection

        .HorizontalAlignment = xlLeft

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Range("V2").Select

    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-14],"" "",RC[-18])"

    Range("V3").Select

    ActiveWindow.ScrollColumn = 6

    ActiveWindow.ScrollColumn = 7

    Range("Z2").Select

    ActiveCell.FormulaR1C1 = _

        "=IF(RC[-21]="""",RC[-22],CONCATENATE(RC[-22],"", "",RC[-21]))"

    Range("Z2").Select

    Selection.AutoFill Destination:=Range("Z2:Z74"), Type:=xlFillDefault

    Range("Z2:Z74").Select

    ActiveWindow.SmallScroll Down:=-48

    ActiveWindow.ScrollColumn = 6

    ActiveWindow.ScrollColumn = 5

    ActiveWindow.ScrollColumn = 4

    ActiveWindow.ScrollColumn = 3

    ActiveWindow.ScrollColumn = 2

    ActiveWindow.ScrollColumn = 1

    Range("D2").Select

End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Nur aktive Zeilen automatisch zusammenführen

18.07.2024 09:41:49

ralf_b

wäre dir damit geholfen?

Sub Taxmetall()

'

' Taxmetall Makro

' - fügt erste Zeile ein und füllt diese Teilweise aus - fasst Benennung1 und Benennung 2 zusammen

'

Dim lrow&: lrow = Cells(Rows.Count, 1).End(xlUp).Row



    Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Range("A2").FormulaR1C1 = "0"

    Range("C2").FormulaR1C1 = "1"

    Range("F2").FormulaR1C1 = "ANLAGEN"

    Range("G2").FormulaR1C1 = "Stück"

    

    formatCell Range("A2"), xlRight, xlCenter, True

    formatCell Range("C2:G2,V2"), xlLeft, xlCenter, True

    formatCell Range("F2"), xlLeft, xlCenter, True



    Range("V2:V"&lrow).FormulaR1C1 = "=CONCATENATE(RC[-14],"" "",RC[-18])"

    Range("Z2:Z" &lrow).FormulaR1C1 = "=IF(RC[-21]="""",RC[-22],CONCATENATE(RC[-22],"", "",RC[-21]))"



End Sub



Function formatCell(rng As Range, hAlgn, vAlgn, bWrp As Boolean)

  With rng

        .HorizontalAlignment = hAlgn

        .VerticalAlignment = vAlgn

        .WrapText = bWrp

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With



End Function

AW: Nur aktive Zeilen automatisch zusammenführen

18.07.2024 11:46:30

TimHo

Noch ene kleine Problematik die gerade aufgetaucht ist.
Bei allen Zeilen klappt das super, nur in der letzten Zeile immer nicht. Was kann das noch sein?

AW: Nur aktive Zeilen automatisch zusammenführen

18.07.2024 15:00:37

ralf_b

bei dieser Codezeile ermittle ich die letzte benutzt Zeile in Spalte "A" . ist in Spalte A die letzte benutzte Zeile auch die gesamt letzte Zeile? sonst mal die 1 anpassen.
pre>lrow = Cells(Rows.Count, 1).End(xlUp).Row

AW: Nur aktive Zeilen automatisch zusammenführen

18.07.2024 11:17:27

TimHo

Moin Ralf,

vielen Dank.
Das sieht sehr gut aus!
Hast du das was ich gemacht habe nun verkleinert und dann die änderung mit eingebracht.
Sehr sehr geil!!!
Danke dir!

Beliebteste Forumthreads (12 Monate)

Nur aktive Zeilen automatisch zusammenführen

Forumthread: Nur aktive Zeilen automatisch zusammenführen

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