Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

identische Zellen zusammenfassen





Frage

Hallo, über Excel organisiere ich Termintabellen die teilweise auch ausgedruckt werden. In Spalte A steht das Datum, in B stehen die Uhrzeiten. Wenn nun an einem Tag zwei Termine eingetragen werden, wird eine neue Zeile eingefügt. Der Wert aus Spalte A wird kopiert und die Uhrzeit entsprechend in B eingetragen. Wie kann ich vor einem Ausdruck jene Zellen in Spalte A automatisch miteinander verbinden lassen, die den gleichen Wert haben? Bsp: ___ _ A________B 1___11.4.____15:00 2___11:4.____17:00 Ziel: 1___________ 15:00 ____11.4. 2____________17:00

Antwort 1 von piano

Hallo
Hier eine hoffentlich zufriedenstellende Lösung:
Sub Zusammenfassen()
Dim Zeile As Integer
Dim i As Integer
Zeile = 1
Do While Cells(Zeile, 1) <> ""
    Cells(Zeile, 1).Select
    i = 1
    Do While Cells(Zeile, 1).Value = Cells(Zeile, 1).Offset(i, 0).Value
        Cells(Zeile, 1).Offset(i, 0).Value = ""
        i = i + 1
    Loop
    Range(Cells(Zeile, 1), Cells(Zeile, 1).Offset(i - 1, 0)).Select
    Call Zentrieren
    Range(Cells(Zeile, 1), Cells(Zeile, 2).Offset(i - 1, 0)).Select
    Call RahmenBilden
    Zeile = Zeile + i
Loop
End Sub

Sub Zentrieren()
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
End Sub

Sub RahmenBilden()
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Zeile = 1 ev. an Beginnzeile anpassen!

Gruß piano

Es wäre nett, wenn Du ein Feedback abgeben könntest,
ob der Lösungsvorschlag Dein Problem gelöst hat.
- probieren geht über studieren -

Antwort 2 von DerKaffee

Wahnsinn! Du bist ein Genie und hast mir echt weitergeholfen!
Liebe Grüße,
Michael