Kod:
Sub SayisalVeriIsleme()
Dim ws As Worksheet
Dim SourceRange As Range, TargetRange As Range, Cell As Range
Dim DataArr() As String, ResultArr() As String
Dim i As Integer, j As Integer
Set ws = ThisWorkbook.Sheets("örnek")
Set SourceRange = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
Set TargetRange = ws.Range("A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 4)
For Each Cell In SourceRange
If Not IsEmpty(Cell.value) Then
DataArr = Split(Cell.value, ",")
For i = LBound(DataArr) To UBound(DataArr)
If IsNumeric(Trim(DataArr(i))) Then
TargetRange.value = Trim(DataArr(i))
Set TargetRange = TargetRange.Offset(1, 0)
End If
Next i
End If
Next Cell
TargetRange.Resize(, 1).Sort key1:=TargetRange, order1:=xlAscending, Header:=xlNo
For i = SourceRange.Rows.Count To 1 Step -1
Set Cell = SourceRange.Cells(i, 1)
If Not IsNumeric(Cell.value) And InStr(1, Cell.value, ",") = 0 And Len(Trim(Cell.value)) > 0 Then
Cell.EntireRow.Delete
End If
Next i
End Sub