• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücrelerin içindeki sayıları tek hücrede büyükten küçüğe sıralamak

D

death200

Katılım
7 Ocak 2017
Mesajlar
18
Excel Vers. ve Dili
2010
Hocalarım benim sorum a1 b1 c1 c1 Hücrelerindeki sayıları d1 hücresi içerisinde büyükten küçüğe doğru sıralamak nedir bunun kodu? yani a1b1c1d1 hücrelerindeki sayılar d1 hücresinde büyükten küçüğe sıralansın 7530 diye
 
Merhaba,

Kısa yolu var mı bilmiyorum, deneyiniz.

Kod: 
=(BÜYÜK(A1:C1;1)&BÜYÜK(A1:C1;2)&BÜYÜK(A1:C1;3))+0
 
Merhaba,
A1,B1,C1 hücrelerindeki sayıları D1 içerisine sıralamak isterseniz =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.
Ancak D1 hücresindeki sayıyı da işin içine katıp yine D1 içine yazdıracaksanız makro kullanmanız gerekecektir.
 
Allah razı olsun işimi gördü hocam müteşekkirim yardımlarınız için.
 
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
 
Alternatif;

Ofis 2019 ve Ofis 365 için çalışır.

213981
 
Ziynettin' Alıntı:
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
Genişletmek için tıkla ...
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 :
Kod: 
=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)))

Kaynak
 
tamer42' Alıntı:
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.
Genişletmek için tıkla ...

Necdet' Alıntı:
Merhaba,

Değer A1 de ise Dizi Formül :
Kod: 
=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)))

Kaynak
Genişletmek için tıkla ...


Merhaba,
Necdet Hocam teşekkürler, yalnız bu işlemi formül yerine kod ile yapmam gerekiyor.
Hücre içindeki sayısal değerleri büyükten küçüğe doğru sıralamak için;
Hücre içindeki sayısal değerleri içeren bir dizi tanımlası yapmaya çalıştım fakat başarılı olamadım

nerede hata yapıyorum, yardımcı olur musunuz

Kod: 
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
 
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
 
Necdet' Alıntı:
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
Genişletmek için tıkla ...
Çok teşekkürler Necdet Hocam,
bir sorum daha olacak, burada büyükten küçüğe doğru sıralama yapıyoruz, tersi küçükten büyüğe doğru sıralama yapmak istediğimizde;

Kod: 
 If a(j) > a(i) Then
satırında ">" işaretini "<" yapmamız gerekecek, bu kadar kodun tamamını yeniden yazmak yerine, sadece bu satırda ">" / "<" değişikliği bir tanımlama ile yapabilir miyiz?

Örnek:
if x=1 then
">"
elseif x=2 then
"<"
end if

gibi....

tekrar teşekkürler,
iyi Çalışmalar.
 
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
 
Korhan Ayhan' Alıntı:
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
Genişletmek için tıkla ...

Korhan Hocam çok teşekkürler,

aşağıdaki satırda ekli hata mesajını alıyorum

Kod: 
 With CreateObject("System.Collections.Arraylist")
 

Ekli dosyalar

  • Resim6.jpg
    Resim6.jpg
    25 KB · Görüntüleme: 2
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 Ayhan' Alıntı:
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.
Genişletmek için tıkla ...
Teşekkürler Korhan Hocam,
elinize kolunuza sağlık!
 
Korhan Ayhan' Alıntı:
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
Genişletmek için tıkla ...
Korhan Hocam merhaba,

Burada K_SORT fonksiyonunda giriş Range (My_Cell) yerine Dizi (my-Arr()) olması durumunda nasıl bir düzenleme yapmak gerekir?
örnek olara Aşağıdaki dizi işlevinin başka bir dizide küçükten büyüğe sıralanması için;
Kod: 
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
teşekkürler,
iyi çalışmalar.
 
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
 
Korhan Ayhan' Alıntı:
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
Genişletmek için tıkla ...
Korhan Ayhan' Alıntı:
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
Genişletmek için tıkla ...
Teşekkürler Korhan Hocam, iyi ki varsınız!
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst