Merhaba, Değerli Üstadlarım,
Bir excel düşünün.
A' dan K sütununa kadar aşağıdaki şekilde değişken datalarım var.
Ben örnek olması açısından ilk üç sütunu yazdım.
A B C
1 1000 100.92.110.17
1 2000 100.92.110.14
1 3000 100.92.110.17
2 500 100.92.110.8
1 3000 100.92.110.18
1 10 100.92.110.20
2 5 100.92.110.18
Mümkünse, istediğim şey şu;
A sütun değeri gruplanırsa 1 ve 2 olduğuna göre A sütunundaki değere göre diğer hücrelerin gruplanması lazım.
Örnek aşağıda...
Yukarıdaki tablo ile karşılaştırması kolay olsun diye reklendirdim.
Amacım. Alt alta yazılı olan değerleri A sütunundaki değerlere göre gruplayıp ilgili tek hücrede araya virgül atarak toplamak.
Başka bir sekmede ya da aynı excel sayfasının boş sütunlarına da yazabilir.
A B
1 1000,2000,3000,10 dikkat edilirse, 1 olan değere karşılık gelen 3000 den yukarıda iki tane olduğu için grupladı ve tek birini yazdı. (Bir bakıma transpose gibi)
2 500,5
Bu şekilde K sütununa kadar bu şekilde gruplayıp ilgili hücreye yazacak şekilde devam etmeli.
Aşağıdaki gibi bir kod yazdım, ancak bu kod, içerir gibi çalışıyor ve gruplamam eksik kalıyor. Bir de toplamda kaç satırım olduğunu hesaplayamadığım için de elimle For döngüsüne 1000 yazdım.
Acaba, bir excel dosyasında kaç satırım varsa otomatik olarak bulup, bu fonksiyonu da o kadar satır için çalıştırabilir mi? Ve hücre değerleri birbirine yakın ise, (500, 0, 5 ) gibi sadece 500 ü getiriyor. Oysa hepsini yan yana getirmeli.
Acaba, bu kodu geliştirebilir misiniz?
Sub concat()
Dim A As String
Dim checkline As Long
Dim un As String
un = "Sevgili, Kadim Dostum; " & Environ("UserName"): seper = "~"
A = Cells(2, 1)
checkline = 2
For k = 2 To 9
Cells(checkline, k + 10) = "," & Cells(checkline, k)
Next k
'Cells(2, 12) = Cells(2, 2)
For i = 3 To 1000
For j = 2 To 9
If Cells(i, 1) = A Then
If InStr(1, Cells(checkline, j + 10), Cells(i, j)) = 0 Then
Cells(checkline, j + 10) = Cells(checkline, j + 10) & "," & Cells(i, j) ' yazdırılan yer
End If
Else
A = Cells(i, 1)
checkline = i
For k = 2 To 9
Cells(checkline, k + 10) = "," & Cells(checkline, k) ' yazdırılan yer
Next k
End If
Next j
Next i
MsgBox "Hadi Gozun Aydin
" & Chr(13) & Chr(13) & "Ayni Satirada Birlestirme Islemi Tamamlandi.", vbInformation, un
End Sub
Teşekkürler.
Bir excel düşünün.
A' dan K sütununa kadar aşağıdaki şekilde değişken datalarım var.
Ben örnek olması açısından ilk üç sütunu yazdım.
A B C
1 1000 100.92.110.17
1 2000 100.92.110.14
1 3000 100.92.110.17
2 500 100.92.110.8
1 3000 100.92.110.18
1 10 100.92.110.20
2 5 100.92.110.18
Mümkünse, istediğim şey şu;
A sütun değeri gruplanırsa 1 ve 2 olduğuna göre A sütunundaki değere göre diğer hücrelerin gruplanması lazım.
Örnek aşağıda...
Yukarıdaki tablo ile karşılaştırması kolay olsun diye reklendirdim.
Amacım. Alt alta yazılı olan değerleri A sütunundaki değerlere göre gruplayıp ilgili tek hücrede araya virgül atarak toplamak.
Başka bir sekmede ya da aynı excel sayfasının boş sütunlarına da yazabilir.
A B
1 1000,2000,3000,10 dikkat edilirse, 1 olan değere karşılık gelen 3000 den yukarıda iki tane olduğu için grupladı ve tek birini yazdı. (Bir bakıma transpose gibi)
2 500,5
Bu şekilde K sütununa kadar bu şekilde gruplayıp ilgili hücreye yazacak şekilde devam etmeli.
Aşağıdaki gibi bir kod yazdım, ancak bu kod, içerir gibi çalışıyor ve gruplamam eksik kalıyor. Bir de toplamda kaç satırım olduğunu hesaplayamadığım için de elimle For döngüsüne 1000 yazdım.
Acaba, bir excel dosyasında kaç satırım varsa otomatik olarak bulup, bu fonksiyonu da o kadar satır için çalıştırabilir mi? Ve hücre değerleri birbirine yakın ise, (500, 0, 5 ) gibi sadece 500 ü getiriyor. Oysa hepsini yan yana getirmeli.
Acaba, bu kodu geliştirebilir misiniz?
Sub concat()
Dim A As String
Dim checkline As Long
Dim un As String
un = "Sevgili, Kadim Dostum; " & Environ("UserName"): seper = "~"
A = Cells(2, 1)
checkline = 2
For k = 2 To 9
Cells(checkline, k + 10) = "," & Cells(checkline, k)
Next k
'Cells(2, 12) = Cells(2, 2)
For i = 3 To 1000
For j = 2 To 9
If Cells(i, 1) = A Then
If InStr(1, Cells(checkline, j + 10), Cells(i, j)) = 0 Then
Cells(checkline, j + 10) = Cells(checkline, j + 10) & "," & Cells(i, j) ' yazdırılan yer
End If
Else
A = Cells(i, 1)
checkline = i
For k = 2 To 9
Cells(checkline, k + 10) = "," & Cells(checkline, k) ' yazdırılan yer
Next k
End If
Next j
Next i
MsgBox "Hadi Gozun Aydin
" & Chr(13) & Chr(13) & "Ayni Satirada Birlestirme Islemi Tamamlandi.", vbInformation, unEnd Sub
Teşekkürler.
