#1
hata.rar
(Dosya Boyutu: 6,67 KB | İndirme Sayısı: 7)
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 SubSub SayisalVeriIsleme()
Dim ws As Worksheet, ws2 As Worksheet
Dim SourceRange As Range, TargetRange As Range, Cell As Range
Dim DataArr() As String
Dim i As Integer, newrow As Long
Set ws = ThisWorkbook.Sheets("örnek")
Set SourceRange = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
Set ws2 = Sheets.Add(After:=Sheets(Sheets.Count))
ws2.Name = "Sonuç Sayfası"
Set TargetRange = ws2.Range("A1")
newrow = 1
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)
newrow = newrow + 1
End If
Next i
End If
Next Cell
ws2.Range("A1:A" & newrow).Sort key1:=ws2.Range("A1"), 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