Microsoft Excel

Herbers Excel/VBA-Archiv

Zellenverbund auflösen auf usedrange

Betrifft: Zellenverbund auflösen auf usedrange von: Sparrow
Geschrieben am: 18.11.2014 13:36:44

Hey,
würdet ihr mich eben den Code so umschreiben dass dieser nicht nur Spalte A durchläuft sondern die UsedRange des Tabellenblatts?
sorry - stehe gerade auf dem Schlauch!

Sub fuellen1()
Dim i As Long
Dim anzahl As Long

Application.ScreenUpdating = False

  
  For i = 2 To Cells(Rows.Count, 2).End(xlUp).Row 
    Range("A" & i).Select
       With Selection
         anzahl = .Count - 1 
         .MergeCells = False 
         Range("A" & i & ":A" & i + anzahl).Value = ActiveCell.Value        
End With
i = i + anzahl 
 Next
Application.ScreenUpdating = True
End Sub

Vielen Dank
Sascha

  

Betrifft: AW: Zellenverbund auflösen auf usedrange von: Hajo_Zi
Geschrieben am: 18.11.2014 13:45:48

Hallo Sascha,

ungetestet

Option Explicit

Sub fuellen1()
    Dim i As Long
    Dim anzahl As Long
    Dim RaZelle As Range
    Application.ScreenUpdating = False
    For Each RaZelle In ActiveSheet.UsedRange
        With RaZelle
            anzahl = .Count - 1
            .MergeCells = False
            Range("A" & i & ":A" & i + anzahl) = RaZelle.Value
        End With
        i = i + anzahl
    Next
    Application.ScreenUpdating = True
End Sub
GrußformelHomepage


  

Betrifft: AW: Zellenverbund auflösen auf usedrange von: Sparrow
Geschrieben am: 18.11.2014 13:48:26

Hey,
Danke für die schnelle Antwort - diese Zeile meckert:

Range("A" & i & ":A" & i + anzahl) = RaZelle.Value

Ne Idee?

Vg Sascha


  

Betrifft: AW: Zellenverbund auflösen auf usedrange von: Daniel
Geschrieben am: 18.11.2014 13:50:08

Hi

probier mal das:

Sub VerbundzellenAuflösen()
Dim Zelle As Range
Dim Wert As Variant
For Each Zelle In ActiveSheet.UsedRange
    If Zelle.MergeCells = True Then
        With Zelle.MergeArea
            Wert = .Cells(1, 1).Value
            .MergeCells = False
            .Value = Wert
        End With
    End If
Next
End Sub
Gruß Daniel