birleşik hücrelerin çözülmesi

[veyselemre]

Sub BirlestirilmisHucreleriCozIlkDegerleDoldur()
Set dic = CreateObject("scripting.dictionary")
sonsat = Cells(Rows.Count, 1).End(3).Row
For x = 1 To sonsat
    ekle = Cells(x, 1).MergeArea.Address
    If Not dic.exists(ekle) Then
        dic.Add ekle, Nothing
    End If
Next x

Range("a1:a" & sonsat).UnMerge
For Each aralik In dic.keys
    Range(aralik).FillDown
Next
Set dic = Nothing
End Sub

 

[AS3434]

Dosyayı inceleyin. C sütunu baz sütundur.

Sub Makro1()
   [a:a].UnMerge
   say = [c65536].End(3).Row
    Range("A1:A" & say).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    For i = 1 To say
   If Cells(i, "c") = "" Then Cells(i, "a").Clear
   Next
   [a2].Select
End Su

 

[Necdet]

Arkadaşlar yanıt vermişler. Bende nihayet olayı anladım, uğraştım, uğraşım boşa gitmesin. Uumarım yardımcı olur.

Public Sub Ayrıştır_Doldur()
Application.ScreenUpdating = False
For i = 1 To [A65536].End(3).Row
    Range("A" & i).Select
    If Selection.Count > 1 Then
        Selection.UnMerge
        Selection.FillDown
    End If
Next i
End Sub

 

[omerceri]

Sn asimerol
aşağıdaki kodu deneyin
sub Çöz()
For i = 1 To 1000
Range("A" & i).Select
If Range("A" & i).MergeCells Then
Range("A" & i).UnMerge
Selection.Value = Range("A" & i)
End If
Next
End Sub

 

[as2380]

arkadaşlar emeği geçen herkese çok teşekkür...