07/02/2024, 11:35
berduş
@atoykan hocamın yöntemine alternatif olarak dizi ile de yapılabilir
Sub VeriAlSirala()
Dim ws As Worksheet
Dim SourceRange As Range, TargetRange As Range, Cell As Range
Dim DataArr() As String, ResultArr() As String
Dim StrSay As Long, j As Integer
Dim TmpDz As Variant, SonDz As Variant, xDz As Variant
Set ws = ThisWorkbook.Sheets("örnek")
xDz = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).Value2
ReDim SonDz(1 To 1000000, 0)
StrSay = 0
For Each xitm In xDz
TmpDgr = "," & xitm
TmpDz = Split(TmpDgr, ",")
For x = 1 To UBound(TmpDz)
If IsNumeric(TmpDz(x)) Then StrSay = StrSay + 1: SonDz(StrSay, 0) = TmpDz(x)
Next x
Next xitm
ws.Range("C1").Resize(StrSay, 1) = SonDz
ws.Range("C1:C" & StrSay).Sort key1:=ws.Range("C1"), order1:=xlAscending, Header:=xlNo
End Sub