Dikey Birleştirme

[customofficer]

Merhaba hücreleri birleştirmeyi biliyorum yatay hücrelerde ancak dikey olunca en üstteki veri kalıyor sadece istedeğim şey şu şekilde;

C1 hücresine c2-c3-c4-c5-c6-c7 birleşmesi gerek. tek tek kesip atmak zorunda kalıyorum. veri çok fazla...

1023	0304.51.00.00.00	- - Tilapya (Oreochromis spp.), Yayın balığı (Pangasius spp.,
1024		Silurus spp., Clarias spp., Ictalurus spp.), Sazan balığı (Cyprinus spp.,
1025		Carassius spp., Ctenopharyngodon idellus, Hypophthalmichthys spp.,
1026		Cirrhinus spp., Mylopharyngodon piceus, Catla catla, Labeo spp.,
1027		Osteochilus hasselti, Leptobarbus hoeveni, Megalobrama spp.),
1028		Yılan balıkları (Anguilla spp.), Nil Levreği (Lates niloticus) ve
1029		yılanbaşlar (Channa spp.)
1030	0304.52.00.00.00	- - Alabalıkgiller
1031	0304.53.00.00.00	- - Bregmacerotidae, Euclichthyidae, Gadidae, Macrouridae,

 

[ÖmerFaruk]

1. Dosyanızın formatı (en azından bu 3 sütun) bu formatta mıdır?
2. B sütunundaki satır dolu ise C sütununda bu dolu satırdan en son satıra kadar birleştireceksiniz. Doğru mudur? Örnekte C sütununda 1023 den 1029 a kadar olan satırlar.
3. Birleşme sonrası sadece - - Tilapya (Oreochromis spp.), Yayın balığı (Pangasius spp., kalacak.Doğru mudur?
4. 1030 olan satırrın altında 1031 de de B sütunu dolu olduğu için C sütununda bir birleştirme olmayacak doğru mudur?

5. Altın üyesiniz. Dosyanızı paylaşsaydınız daha kolay olackatır.

 

[customofficer]

hocam yaptım dosya

 

[customofficer]

dikey ardışık hücreleri tek hücrede birleştirmem lazım çalışmamda.

 

[ÖmerFaruk]

Kodu sayfa üzerinde çalıştırınca D1 den itibaren istedğiniz formata çevirecek.

Sub Dikeybirleştirözel()
    Veri = Range("A1").CurrentRegion.Value
    ReDim Liste(1 To UBound(Veri), 1 To 2)
    For i = 1 To UBound(Veri)
        If Veri(i, 1) <> "" Or Left(Veri(i, 2), 1) = "-" Then
            Say = Say + 1
            Liste(Say, 1) = Veri(i, 1)
            Kontrol = 0
            If Right(Veri(i, 2), 1) = "-" Then
                Liste(Say, 2) = Left(Veri(i, 2), Len(Veri(i, 2)) - 1)
                Kontrol = 1
            Else
                Liste(Say, 2) = Veri(i, 2)
            End If
        ElseIf Veri(i, 1) = "" And Kontrol = 1 Then
            Liste(Say, 2) = Liste(Say, 2) & Veri(i, 2)
            Kontrol = 0
        End If
    Next i
    'Hedef aralığınız farklı ise aşağıdaki D1 adresini değiştiriniz
    Range("D1").Resize(Say, 2).NumberFormat = "@"
    Range("D1").Resize(Say, 2) = Liste
End Sub