- Katılım
- 15 Mart 2005
- Mesajlar
- 43,385
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
Özelden mesaj yazmanıza gerek yok. Foruma yazarsanız benim dışımda cevap vermek isteyen arkadaşlarda başlığınıza yorum yapabilirler.
Paylaştığınız dosyanıza göre aşağıdaki kodu deneyiniz.
Sonuçlar B sütununa yazılmaktadır. İşlemler tamamen A sütununda olsun derseniz kod içinde geçen B sütun harflerini A olarak revize edebilirsiniz.
Paylaştığınız dosyanıza göre aşağıdaki kodu deneyiniz.
Sonuçlar B sütununa yazılmaktadır. İşlemler tamamen A sütununda olsun derseniz kod içinde geçen B sütun harflerini A olarak revize edebilirsiniz.
C++:
Option Explicit
Sub Concatenate_Cell()
Dim My_Data As Variant, X As Long, Y As Long
Dim Count_Data As Long, Rng As Range
Application.ScreenUpdating = False
Range("B:B").ClearContents
My_Data = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row).Value
ReDim My_List(1 To UBound(My_Data, 1), 1 To 1)
For X = LBound(My_Data, 1) To UBound(My_Data, 1)
If IsNumeric(Left(My_Data(X, 1), 1)) Then
Count_Data = Count_Data + 1
My_List(Count_Data, 1) = My_Data(X, 1)
For Y = X + 1 To UBound(My_Data, 1) - 1
If Not IsNumeric(Left(My_Data(Y, 1), 1)) Then
My_List(Count_Data, 1) = My_List(Count_Data, 1) & vbLf & My_Data(Y, 1)
Else
X = Y - 1
Exit For
End If
Next
End If
Next
Range("B2").Resize(Count_Data) = My_List
Range("B:B").Replace Chr(10), "|"
Range("B:B").Replace vbCr, "|"
Range("B:B").Replace vbLf, "|"
For Each Rng In Range("B:B").SpecialCells(xlCellTypeConstants)
For X = 10 To 1 Step -1
Rng = Replace(Rng, String(X, "|"), Chr(10))
Next
Next
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
