Çözüldü Verileri Yan Yana Sıralama

[schlecht]

=ConCat(",";A1:B100) formülünu kullanıyorum, formül a1 b100 arası verileri aralarına virgül koyarak yan yana sıralıyor. Bu formülü makro ile yapmak istiyorum.

Teşekkürler.

 

[Erdem Akdemir]

Merhaba,

Sorunuz eksik. ConCat excel'in yerleşik fonksiyonlarından biri değil.
Concat KTF'dir. KTF'yi incelerseniz makro kodunu'da görürsünüz.

 

[u.L.a.s]

Hangi sheet içinde bu işlemi yapacaksan vba düzeneğinde o sheet içerisindeki kod düzeneğine aşağıdaki kodları yerleştirin.

Sub concatAG()
Dim rng As Range
Dim arrVals
 
    Set rng = Range("A1")
 
    While rng.Value <> ""
        arrVals = rng.Resize(, 2)
 
        arrVals = Application.Transpose(arrVals)
        arrVals = Application.Transpose(arrVals)
        rng.Offset(, 3) = Join(arrVals, ",")
 
        Set rng = rng.Offset(1)
    Wend
 
End Sub

 

[schlecht]

merhaba sayın u.L.a.s kodu denedim, sayıları yanlarına virgül koyup alt alta sıralıyor. a sütünundaki sayıları virgül koyup c1 e yan yana sıralamasını istiyorum.

 

[Erdem Akdemir]

Merhaba,

Aşağıdaki kodu kullanabilirsiniz.

=birles(A1:A10;",")

Function birles(hucre As Range, Optional imlec As String = "") As String

For Each alan In hucre

If alan = "" Then
Else
k = k & alan & imlec
End If
Next alan

If imlec = "" Then
birles = k
Else
birles = VBA.Left(k, VBA.Len(k) - 1)
End If
End Function

 

[schlecht]

Function u nasıl çalıştırıcaz yapamadım sanırım hata verdi.

 

[u.L.a.s]

eklediğin dosyayı ben indiremiyorum.

a1 de diyelimki 12 var b1 de 23 var bu makro kod c1 e 12,23 olarak veriyi yazar senin istediğin bu şekilde değil miydi?

 

[schlecht]

a1=12
a2=13
a3=14
.
.
.
Sonuç C1 > 12,13,14 olması gerekiyor. A sütünuna yazılanların hepsini C1 de yan yana sıramalası gerelir. İlk mesajımda yazdığım formül a ve b sütünuna yazılanları yan yana soralıyor yine tek hücrede

 

[u.L.a.s]

aşağıdaki kod düzeneğini yerleştirin.

Option Explicit

Sub concatAG()
Dim rng As Range
Dim arrVals

    Set rng = Range("A1")

    While rng.Value <> ""
        arrVals = rng.Resize(, 2)

        arrVals = Application.Transpose(arrVals)
        arrVals = Application.Transpose(arrVals)
        rng.Offset(, 2) = Join(arrVals, ",")

        Set rng = rng.Offset(1)
    Wend

End Sub

 

[schlecht]

Aynı sonucu verdi. Sanırım anlatamadım.
Resimdeki gibi bir sonuç elde etmeye çalışıyorum. İlk mesajdaki formül bunu yapıyor.

 

[Erdem Akdemir]

Function u nasıl çalıştırıcaz yapamadım sanırım hata verdi.

Function'ı modüle ekleyin.

Aşağıdaki gibi kullanın.

=birles(A1:A10;",")

 

[u.L.a.s]

evet en başından beri çok farklı durumlar algıladım. örnek dosyayı göremedim birde.
aşağıdaki kod düzeneğini deneyeceksiniz o zaman

Sub HucreDegerBirlestir()
    Dim xRng As Range, cll As Range
    Dim xStr As String
    Set xRng = Range("A:A").SpecialCells(xlCellTypeConstants, 23)
    If xRng.Count = 0 Then
        MsgBox "Dolu Hücre yok"
    End If
    For Each cll In xRng
        xStr = xStr & IIf(Len(xStr) = 0, "", ",") & cll.Value
    Next
    Range("C1").Value = xStr
End Sub

 

[schlecht]

Evet bu çok teşekkür ederim, biraz uğraştırdım sizi de...

 

[tahsinanarat]

Option Explicit
Sub BİRLEŞTİR()
Dim X As Integer
Range("C1").ClearContents
For X = 1 To Cells(Rows.Count, "A").End(3).Row
If Cells(X, "A") <> "" Then
Range("C1") = Range("C1") & "," & Cells(X, "A")
End If
Next
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub