Bir Excel Hücresinde Sayısal Değerleri Sıralama

1 2
05/02/2024, 23:59

208319

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
06/02/2024, 14:40

atoykan

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 Sub
06/02/2024, 21:23

208319

atoykan bey çok teşşekkür ederim.
07/02/2024, 00:14

208319

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

atoykan

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 Sub
şeklinde güncelleyin kodu. Bu kod öncekinden farklı olarak çalışmanıza sonuç sayfası adlı bir çalışma sayfası ekleyerek orada listeler sonuçlarınızı. 700000 gibi kayıtla bu işlemi yapmak için excelde çok doğru bir tercih değil performans sorunu yaşayacaksınız. Bu ayıklamayı excele aktarmadan önce kaynakta yapmayı denemenizi tavsiye ederim.
07/02/2024, 09:44

berduş

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?
1 2