Soru hücre birleştirme

[duyguerim]

Merhabalar

B sutununda olan verilerimi a stununda birleştirip bütün satırlara tek bir isim vermek istiyorum bunu nasıl yaparım

Örnek
B2+B3+B4 satırında Ankara yazıyor
B5+B6 satırında izmir yazıyor.
A sütununda B2+B3+B4 ü tek hücre yapıp 1 numumara demek istiyorum aynı şeklide A sütununda B5+B6 ya 2 numara demek istiyporum bunları nasıl yaparım

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub birlestir()
son = Cells(Rows.Count, "B").End(3).Row

Application.DisplayAlerts = False
For i = 2 To son
    If Cells(i, "B") = Cells(i - 1, "B") Then
        Range("A" & i - 1 & ":A" & i).Merge
        Cells(i, "A") = WorksheetFunction.Max(Range("A1:A" & i)) + 1
    Else
        Cells(i, "A") = WorksheetFunction.Max(Range("A1:A" & i)) + 1
    End If
Next
Application.DisplayAlerts = True
End Sub

 

[duyguerim]

çok teşekkürler elinize emeğinize sağlık....

 

[duyguerim]

Peki birleştirilen hücrelerin aynı yükseklikte olması sağlanabilir mi?

 

[YUSUF44]

Nasıl yani?

 

[duyguerim]

şimdi ankara yazan satırdan 3 tane var bolu yazan satırdan 2
numara verirken birleştirdiğimizde yükseklik birinde 60 piksel oluyor diğerinde 40 piksel bunların hepsini 60 piksel nasıl yapabilirim.

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Sub birlestir()
son = Cells(Rows.Count, "B").End(3).Row
Range("A2:A" & son).ClearContents
adet = 0
Application.DisplayAlerts = False
For i = 2 To son
    If Cells(i, "B") = Cells(i - 1, "B") Then
        Range("A" & i - 1 & ":A" & i).Merge
        If say > adet Then adet = say
        Cells(i, "A") = WorksheetFunction.Max(Range("A1:A" & i)) + 1
    Else
        Cells(i, "A") = WorksheetFunction.Max(Range("A1:A" & i)) + 1
            say = WorksheetFunction.CountIf(Range("B2:B" & son), Cells(i, "B"))
        If say > adet Then adet = say
    End If
Next
enyuksek = adet * 20
For j = 2 To son
    Cells(j, "A").Select
    say = Selection.Count
    yukseklik = Int(enyuksek / say)
    Rows(j).RowHeight = yukseklik
Next
Range("A2:A" & son).VerticalAlignment = xlCenter
Application.DisplayAlerts = True
End Sub

 

[duyguerim]

Çok teşekkür ederim emeğinize sağlık....

 

[YUSUF44]

Kodun aşağıdaki hali daha kullanışlı oldu:

Sub birlestir()
son = Cells(Rows.Count, "B").End(3).Row
Range("A2:A" & son).ClearContents
Range("A2:A" & son).UnMerge
adet = 0
Application.DisplayAlerts = False
For i = 2 To son
    If Cells(i, "B") = Cells(i - 1, "B") Then
        Range("A" & i - 1 & ":A" & i).Merge
        If say > adet Then adet = say
        Cells(i, "A") = WorksheetFunction.Max(Range("A1:A" & i)) + 1
    Else
        Cells(i, "A") = WorksheetFunction.Max(Range("A1:A" & i)) + 1
            say = WorksheetFunction.CountIf(Range("B2:B" & son), Cells(i, "B"))
        If say > adet Then adet = say
    End If
Next
enyuksek = adet * 20
For j = 2 To son
    Cells(j, "A").Select
    say = Selection.Count
    yukseklik = Int(enyuksek / say)
    Rows(j).RowHeight = yukseklik
Next
Range("A2:B" & son).VerticalAlignment = xlCenter
Application.DisplayAlerts = True
End Sub

 

[duyguerim]

Öncelik ile ilginiz için gerçektende çok teşekkür ederim. Ancak son gönderdiğiniz kod da Rows(j).RowHeight = yukseklik satırında hata veriyor bilginiz olsun

 

[YUSUF44]

Dosyayı hatalı haliyle paylaşır mısınız? Benim denemelerimde hata vermedi çünkü.