TextBox'a Sırası İle Hücredeki Verileri Al

[Hsn55]

İyi günler;
Ekli dosyada Verim Yüzdesi Sayfasındaki I716 hücre aralığına girilen rakamları sırala butonuna bastığımızda örnekteki gibi TextBox1'e rakam sırası ile küçükten başlayarak ve araya virgül koyarak makro ile aldırabilir miyiz. Yardımcı olursanız sevinirim .Saygılarımla
https://dosyam.org/Xl7/Örnek.xlsm

 

[Ömer]

Merhaba,

Deneyiniz.

Sub YuvarlatılmışDikdörtgen2_Tıkla()
    Dim i As Range, d As String
    For Each i In Range("I7:P16")
        If i <> "" Then
            d = d & "," & i
        End If
    Next i
    ActiveSheet.TextBox2.Text = ""
    ActiveSheet.TextBox2.Text = WorksheetFunction.Substitute(d, ",", "", 1)
End Sub

 

[Hsn55]

Ömer bey teşekkür ederim. Rakamları küçükten büyüğe doğru sıralamalı şekilde alabilir mi?

 

[Korhan Ayhan]

Deneyiniz.

Kodun çalışması için sisteminizde .NET Framework 3.5 sürümünün yüklü olması gerekmektedir.

Option Explicit

Sub YuvarlatılmışDikdörtgen2_Tıkla()
    Dim Veri As Range
    
    With CreateObject("System.Collections.ArrayList")
        For Each Veri In Range("I7:P16").SpecialCells(xlCellTypeConstants, 1).Cells
            .Add Veri.Value
        Next
        
        .Sort
        ActiveSheet.TextBox2.Text = Join(.ToArray, ",")
    End With
End Sub

 

[Hsn55]

Deneyiniz.

Kodun çalışması için sisteminizde .NET Framework 3.5 sürümünün yüklü olması gerekmektedir.

Option Explicit

Sub YuvarlatılmışDikdörtgen2_Tıkla()
    Dim Veri As Range
   
    With CreateObject("System.Collections.ArrayList")
        For Each Veri In Range("I7:P16").SpecialCells(xlCellTypeConstants, 1).Cells
            .Add Veri.Value
        Next
       
        .Sort
        ActiveSheet.TextBox2.Text = Join(.ToArray, ",")
    End With
End Sub

Korhan bey teşekkür ederim. Framework 4 sürümü yüklü fakat kod hata veriyor

 

[Korhan Ayhan]

Netten ilgili sürümü bulup yüklerseniz sorun çözülecektir.

 

[Ömer]

Alternatif.
Dizi içine alarak yada yardımcı sütun ile farklı yollarda denenebilir. Veriler sayı olduğu için küçük fonksiyonunu kullanarak yaptım.

Sub YuvarlatılmışDikdörtgen2_Tıkla()

    Dim i As Integer, d As String, say As Integer, alan As Range
   
    Set alan = Range("I7:P16").SpecialCells(xlCellTypeConstants, 23)
    say = alan.Count
   
    For i = 1 To say
        d = d & "," & WorksheetFunction.Small(alan, i)
    Next i
   
    ActiveSheet.TextBox2.Text = ""
    ActiveSheet.TextBox2.Text = WorksheetFunction.Substitute(d, ",", "", 1)
   
End Sub