05/02/2024, 23:59
Bir Excel Hücresinde sayısal değerleri Sıralama Harsel değerleri hücresiyle birlikte yok etme konusunda yardımlarınızı talep ediyorum.(örnek ektedir) teşekkürler
Sayfalar: 1 2
05/02/2024, 23:59
06/02/2024, 14:40
Excelinizin Vba editörüne aşağıdaki kodu yapıştırın. Akabinde ister sayfanıza bir buton ekleyin ve kodu butona atayın tıkladığınızda çalışsın veya isterseniz Makrolardan çağırıp çalıştırın.
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 Sub06/02/2024, 21:23
atoykan bey çok teşşekkür ederim.
07/02/2024, 00:14
bir yerde hesaplama hatası yapmışım alt kısma sıralama vermişim (veri a1 hücresinde sıralama b1 hücresinde baştan sona doğru gitmesi gerekirdi) çünkü veri sayfanın 700000 başladığı için yer sorunu olabilir. veri hizasından başlatabilirsek çok mükemmel olacak a1 hücresindeki veriler b1 de baştan sona sıralansın. benden kaynaklı hatadan dolayı çok özür dilerim. hoşçakalın.
07/02/2024, 09:00
Kod:
Sub 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 Sub07/02/2024, 09:44
sayın @208319, 700.000 satır virgüllerle ayrılmış verileri içeriyorsa sonuç 1 milyon satırı geçebilir bu durumda ne yapılacak?
Sayfalar: 1 2