DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
=BİRLEŞTİR(BÜYÜK(A1:C1;1);BÜYÜK(A1:C1;2);BÜYÜK(A1:C1;3))
benzeri bir formül kullanabilirsiniz.=Buyukten_Kucuk(A1:A4)
Function Buyukten_Kucuk(alan)
a = Application.Transpose(alan)
For i = LBound(a) To UBound(a)
For j = i To UBound(a)
If a(j) > a(i) Then
ww = a(j)
a(j) = a(i)
a(i) = ww
End If
Next j
Next i
Buyukten_Kucuk = Val(Join(a, ""))
End Function
Merhaba,Bende KFC yazmıştım.
Module aşağıdaki yazın ve D1 'e=Buyukten_Kucuk(A1:A4)
Kod:Function Buyukten_Kucuk(alan) a = Application.Transpose(alan) For i = LBound(a) To UBound(a) For j = i To UBound(a) If a(j) > a(i) Then ww = a(j) a(j) = a(i) a(i) = ww End If Next j Next i Buyukten_Kucuk = Val(Join(a, "")) End Function
Merhaba,
Bir hücre içinde yan-yana rastgele sayılar (264598387516846) yazılı, bu sayıları aynı şekilde yandaki hücrede küçükten büyüğe sıralı yazdırmak istersek bu kodu nasıl düzenleyebiliriz?
teşekkürler,
iyi akşamlar.
Merhaba,
Değer A1 de ise Dizi Formül :
KaynakKod:=METNEÇEVİR(TOPLA(KÜÇÜK(--PARÇAAL(A1;SATIR(DOLAYLI("1:"&UZUNLUK(A1)));1);SATIR(DOLAYLI("1:"&UZUNLUK(A1))))*10^(UZUNLUK(A1)-SATIR(DOLAYLI("1:"&UZUNLUK(A1)))));YİNELE("0";UZUNLUK(A1)))
Function Buyukten_Kucuk(Hucre As Range)
Dim a() As Variant, aVar As Variant
Dim i As Long, j As Long
Dim t As Long, k As Long
aVar = Hucre.Value
For k = 1 To Len(aVar)
t = k - 1
a(t) = Mid(aVar, k, 1)
Next k
For i = LBound(a) To UBound(a)
For j = i To UBound(a)
If a(j) > a(i) Then
ww = a(j)
a(j) = a(i)
a(i) = ww
End If
Next j
Next i
Buyukten_Kucuk = Val(Join(a, ""))
End Function
Function Buyukten_Kucuk(Hucre As Range)
Dim a() As Variant, _
i As Integer, _
j As Integer, _
t As Integer, _
k As Integer, _
ww As String
ReDim a(Len(Hucre) - 1)
For k = 1 To Len(Hucre)
t = k - 1
a(t) = Mid(Hucre, k, 1)
Next k
For i = LBound(a) To UBound(a)
For j = i To UBound(a)
If a(j) > a(i) Then
ww = a(j)
a(j) = a(i)
a(i) = ww
End If
Next j
Next i
Buyukten_Kucuk = Val(Join(a, ""))
End Function
Çok teşekkürler Necdet Hocam,Merhaba,
Dizi uzunluğunu belirtmemişsiniz.
ReDim a(Len(Hucre) - 1)
Kod:Function Buyukten_Kucuk(Hucre As Range) Dim a() As Variant, _ i As Integer, _ j As Integer, _ t As Integer, _ k As Integer, _ ww As String ReDim a(Len(Hucre) - 1) For k = 1 To Len(Hucre) t = k - 1 a(t) = Mid(Hucre, k, 1) Next k For i = LBound(a) To UBound(a) For j = i To UBound(a) If a(j) > a(i) Then ww = a(j) a(j) = a(i) a(i) = ww End If Next j Next i Buyukten_Kucuk = Val(Join(a, "")) End Function
If a(j) > a(i) Then
=K_SORT(A1;1) Küçükten büyüğe sıralama
=K_SORT(A1;0) Büyükten küçüğe sıralama
Option Explicit
Function K_SORT(My_Cell As Range, Optional Sort_Option As Boolean) As String
Dim X As Integer
Application.Volatile True
With CreateObject("System.Collections.Arraylist")
For X = 1 To Len(My_Cell)
.Add Mid(My_Cell, X, 1)
Next
.Sort
If Sort_Option = True Then .Sort Else .Reverse
K_SORT = Join(.ToArray, "")
End With
End Function
Korhan Hocam çok teşekkürler,Alternatif KTF;
Kod:=K_SORT(A1;1) Küçükten büyüğe sıralama =K_SORT(A1;0) Büyükten küçüğe sıralama
C++:Option Explicit Function K_SORT(My_Cell As Range, Optional Sort_Option As Boolean) As String Dim X As Integer Application.Volatile True With CreateObject("System.Collections.Arraylist") For X = 1 To Len(My_Cell) .Add Mid(My_Cell, X, 1) Next .Sort If Sort_Option = True Then .Sort Else .Reverse K_SORT = Join(.ToArray, "") End With End Function
With CreateObject("System.Collections.Arraylist")
Teşekkürler Korhan Hocam,Bu nesne .NET Framework 3.5 yüklemesine ihtiyaç duyuyormuş. Sisteminizde daha üst versiyonu olsa da kurup deneyiniz.
Kurulum yaptıktan sonra bilgisayarınızı kapatıp açtıktan sonra kodu deneyiniz.
Korhan Hocam merhaba,Alternatif KTF;
Kod:=K_SORT(A1;1) Küçükten büyüğe sıralama =K_SORT(A1;0) Büyükten küçüğe sıralama
C++:Option Explicit Function K_SORT(My_Cell As Range, Optional Sort_Option As Boolean) As String Dim X As Integer Application.Volatile True With CreateObject("System.Collections.Arraylist") For X = 1 To Len(My_Cell) .Add Mid(My_Cell, X, 1) Next .Sort If Sort_Option = True Then .Sort Else .Reverse K_SORT = Join(.ToArray, "") End With End Function
Sub Dizim()
Dim Arr(5) As Long
Dim Arr2(5) As Long
Arr(0) = 54
Arr(1) = 35
Arr(2) = 64
Arr(3) = 51
Arr(4) = 24
Arr(5) = 42
Arr2() = K_SORT(Arr(), True)
End Sub
Option Explicit
Function K_SORT(My_Array As Variant, Optional Sort_Option As Boolean) As Variant
Dim Veri As Variant
Application.Volatile True
With CreateObject("System.Collections.Arraylist")
For Each Veri In My_Array
.Add Veri
Next
.Sort
If Sort_Option = True Then .Sort Else .Reverse
K_SORT = .ToArray
End With
End Function
Sub Dizim()
Dim Arr(5) As Variant
Dim Arr2 As Variant
Arr(0) = 54
Arr(1) = 35
Arr(2) = 64
Arr(3) = 51
Arr(4) = 24
Arr(5) = 42
Arr2 = K_SORT(Arr(), True)
MsgBox Join(Arr2, vbCr)
End Sub
Deneyiniz.
C++:Option Explicit Function K_SORT(My_Array As Variant, Optional Sort_Option As Boolean) As Variant Dim Veri As Variant Application.Volatile True With CreateObject("System.Collections.Arraylist") For Each Veri In My_Array .Add Veri Next .Sort If Sort_Option = True Then .Sort Else .Reverse K_SORT = .ToArray End With End Function
C++:Sub Dizim() Dim Arr(5) As Variant Dim Arr2 As Variant Arr(0) = 54 Arr(1) = 35 Arr(2) = 64 Arr(3) = 51 Arr(4) = 24 Arr(5) = 42 Arr2 = K_SORT(Arr(), True) MsgBox Join(Arr2, vbCr) End Sub
Teşekkürler Korhan Hocam, iyi ki varsınız!Deneyiniz.
C++:Option Explicit Function K_SORT(My_Array As Variant, Optional Sort_Option As Boolean) As Variant Dim Veri As Variant Application.Volatile True With CreateObject("System.Collections.Arraylist") For Each Veri In My_Array .Add Veri Next .Sort If Sort_Option = True Then .Sort Else .Reverse K_SORT = .ToArray End With End Function
C++:Sub Dizim() Dim Arr(5) As Variant Dim Arr2 As Variant Arr(0) = 54 Arr(1) = 35 Arr(2) = 64 Arr(3) = 51 Arr(4) = 24 Arr(5) = 42 Arr2 = K_SORT(Arr(), True) MsgBox Join(Arr2, vbCr) End Sub