Skip to main content

AccessTr.neT


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

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

Çözüldü #1
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
.rar hata.rar (Dosya Boyutu: 6,67 KB | İndirme Sayısı: 7)
Cevapla
#2
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

Cevapla
#3
atoykan bey çok teşşekkür ederim.
Cevapla
#4
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.
Son Düzenleme: 07/02/2024, 00:38, Düzenleyen: 208319. (Sebep: eksik bilgi)
Cevapla
#5
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.
Cevapla
#6
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?
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task