Aralara Nokta Koyarak Birleştirmem Gerek

[xtrkax]

Merhabalar, aslında birleştirmeyi biliyorum hem de çok kullanıyorum lakin burada durum çok daha farklı bir hal alıyor. Çünkü boş olan hücrelerde bir birleştirme yapmaması gerekiyor.

Ekte ki dosyada istediğim birleştirme şeklini tarif ettim.

 

[ÖmerBey]

Merhaba,
KTF isterseniz buyurunuz...

Function NOKTALIBİRLEŞTİR(alan As Range, ayrac)
Dim hcr()
For Each a In alan
    If a <> "" Then
        b = b + 1
        ReDim Preserve hcr(1 To b)
        hcr(b) = a
    End If
Next
NOKTALIBİRLEŞTİR = Join(hcr, ayrac)
End Function

Yukarıdaki kodu boş bir modüle kopyaladıktan sonra

=NOKTALIBİRLEŞTİR(B2:F2;".")

formülüyle birleştirme işlemini yapabilirsiniz.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kullanıcı tanımlı fonksiyonu deneyiniz.

Hücrede kullanım şekli;

=KBİRLEŞTİR(B2:F2;".")

Function KBİRLEŞTİR(Alan As Range, Optional Kriter = ".") As String
    Dim Veri As Range
    For Each Veri In Alan
        If Veri.Value <> "" Then
            If KBİRLEŞTİR = "" Then
                KBİRLEŞTİR = Veri.Value
            Else
                KBİRLEŞTİR = KBİRLEŞTİR & Kriter & Veri.Value
            End If
        End If
    Next
End Function

 

[veyselemre]

Sub vEmre()
    lst = Range("B2:F" & Cells(Rows.Count, 1).End(3).Row).Value
    ReDim w(1 To UBound(lst), 1 To 1)
    Range("J2:J" & Rows.Count).ClearContents
    For i = 1 To UBound(lst)
        w(i, 1) = Replace(Trim(Join(Application.Index(lst, i), " ")), " ", ".")
    Next i
    [j2].Resize(UBound(w)).Value = w
End Sub

 

[feridici_genc]

Formül ile daha ilgi çekici duruyor.

 

[ÖmerBey]

Formül ile:

=YERİNEKOY(BİRLEŞTİR(EĞER(B2="";"";"."&B2);EĞER(C2="";"";"."&C2);EĞER(D2="";"";"."&D2);EĞER(E2="";"";"."&E2);EĞER(F2="";"";"."&F2));".";"";1)

 

[xtrkax]

Merhabalar hepinize sonsuz teşekkürlerimi sunuyorum.

Formül ile daha rahat oldu ve işimi fazlasıyla gördü. iyi çalışmalar dilerim

 

[feridici_genc]

mucit bey,
ben yapmak istiyordum