For-Next döngüsünde Kodun kısaltılması

[tamer42]

Merhabalar,

Aşağıda bir bölümünü eklediğim kodda A sütunundan başlayararak Z sütununa kadar; her sütun içerisinde hücreleri birleştirmek düşüncesindeyim;

 If j - i > 2 Then

    Range("A" & i & ":A" & j).Select
     Selection.Merge
    Range("B" & i & ":B" & j).Select
        Selection.Merge
            Range("C" & i & ":C" & j).Select
                Selection.Merge
                    Range("D" & i & ":D" & j).Select
                        Selection.Merge

...............
......................

                        Range("Y" & i & ":Y" & j).Select
                           Selection.Merge
                        Range("Z" & i & ":Z" & j).Select
                           Selection.Merge
                        
end if

Yalnız bu şekilde yazmak kodu çok uzatıyor, bu kodları;

for
........

next

döngüsü içerisine sokarak kod kısaltılabilirmi?

İyi Çalışmalar.

 

[Ferhat Pazarçevirdi]

Aşağıdaki gibi olabilir. i ve j'nin değerleri daha önce hesaplanmış olmalı ve tabi ki; sıfırdan büyük olmamalılar

For x = 1 To 26
    If j - i > 2 Then:Range(Cells(i, x), Cells(j, x)).Merge
Next x

 

[tamer42]

Teşekkürler....

 

[tamer42]

Merhaba,

Kodları farklı bir yerde çalıştırırken;

"The Selection contains multiple data values. Merging into one cell will keep the upper-left most data only"

uyarı mesajı veriyor, yani birleştirilecek alttaki hücreler dolu olduğu için böyle bir mesaj veriyor.
Alttaki verilerin hepsi aynı ; benim için farketmez bu mesajdan nasıl kurtulurum.

İyi Çalışmalar.

 

[Ferhat Pazarçevirdi]

Aşağıdakini deneyin.

Application.DisplayAlerts = False
For x = 1 To 26
    If j - i > 2 Then: Range(Cells(i, x), Cells(j, x)).Merge
Next x
Application.DisplayAlerts = True

 

[Necdet]

Anladığım kadarıyla önce hücrelerin içeriklerini birleştiriyorsunuz, sonra Merge ediyorsunuz.

Aşağıdaki kodları dener misiniz?

Sub Birlestir()
For i = 1 To [A65536].End(3).Row
    For j = 2 To 26
        Cells(i, 1) = Cells(i, 1) & Cells(i, j)
    Next j
    Range(Cells(i, 2), Cells(i, 26)).Clear
    Range(Cells(i, 1), Cells(i, 26)).Merge
Next i
End Sub

 

[tamer42]

Application.DisplayAlerts = False

bütün olayı çözdü,

elinize sağlık...