listbox tarih sütunu tarih sıralaması

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
641
Excel Vers. ve Dili
excel 2010

excel 2013
Altın Üyelik Bitiş Tarihi
06-08-2025
Merhaba,

Aşağıdaki kod ile yapmaya çalıştığım şey listbox1 üzerine excel sayfasından 8 sütunün verilerini almak ve "C" sütunu kriterine göre bunları süzmek. Süzme yaptıktan sonra listbox üzerinde 4. kolonda yeralan tarih formatına göre nasıl sıralatabilirim.


[KOD] Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr (1 ila 8, 1 ila 1)
Çalışma Sayfaları ile ("Alış")
Me.ListBox1.Clear
Eğer .FilterMode Sonra .ShowAllData
K = .Range ("C2: C65536") olarak ayarlayın. (ComboBox1.Text & "*",, xlValues, xlWhole) öğesini bulun
K Hiçbir Şey Değilse O Zaman
adrs = k.Address
Yapmak
a = a + 1
ReDim Myarr Koru (1'den 8'e, 1'den a'ya)
J = 1 ila 12 için
myarr (j, a) = .Hücreler (k.Row, j) .Değer
Sonraki j
K = Aralık ("C2: C65536") olarak ayarlayın. Sonrakini Bul (k)
Değilken Döngü k Hiçbir Şey Değildir ve k.Address <> adrs
ListBox1.Column = myarr
Bitiş Eğer
İle bitmek

T = 0 ila 7 için
ListBox1.List (t, 4) = Biçim (ListBox1.List (t, 4), "gg.aa.yyyy")
Sonraki T

ListBox1.List = Diz (ListBox1.List, TextBox4.Value) [/ CODE]
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Googladan mı çevirdiniz kodları?
Orjinal halini paylaşırsanız daha muteber olacak.
 

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
641
Excel Vers. ve Dili
excel 2010

excel 2013
Altın Üyelik Bitiş Tarihi
06-08-2025
Googladan mı çevirdiniz kodları?
Orjinal halini paylaşırsanız daha muteber olacak.
Çevirme diye birşey yapmıyorum Ömer Faruk bey, excelden kod olarak alıyorum, buraya kod aralığına yapıştırıyorum, neden böylesi birşey var anlamadım. Daha öncede birkaçkez denemeye çalıştım birşeyler nasıl oluyorsa değişiyor. Ekleme yapacağım
 

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
641
Excel Vers. ve Dili
excel 2010

excel 2013
Altın Üyelik Bitiş Tarihi
06-08-2025
Kod:
Private Sub ComboBox1_change()
On Error Resume Next
ListBox1.ColumnCount = 8
ListBox1.ColumnWidths = "30;60;180;60;50;100;50;50"

Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(1 To 8, 1 To 1)
With Worksheets("Alış")
    Me.ListBox1.Clear
    If .FilterMode Then .ShowAllData
    Set k = .Range("C2:C65536").Find(ComboBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 8, 1 To a)
            For j = 1 To 12
                myarr(j, a) = .Cells(k.Row, j).Value
            Next j
            Set k = Range("C2:C65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = myarr
    End If
End With

For t = 0 To 7
       ListBox1.List(t, 4) = Format(ListBox1.List(t, 4), "dd.mm.yyyy")
Next t

ListBox1.List = Diz(ListBox1.List, TextBox4.Value)



Dim i As Long
Dim borctoplami As Double
For i = 0 To ListBox1.ListCount - 1
        borctoplami = ListBox1.List(i, 6) + borctoplami
Next i
TextBox1 = Format(borctoplami, "#,##0.00")

Dim z As Long
Dim alacaktoplami As Double
For z = 0 To ListBox1.ListCount - 1
        alacaktoplami = ListBox1.List(z, 7) + alacaktoplami
Next z
TextBox2 = Format(alacaktoplami, "#,##0.00")

TextBox3 = Format(borctoplami - alacaktoplami, "#,##0.00")



End Sub


Listbox üzerinde cari hesap ekstresi oluşturmaya çalışıyorum. userform13 üzerindeki listbox1 e Alış adlı excel sayfasından veri yüklüyorum ve combobox1 de ünvan seçiyorum, bir firmaya ait alış faturalarını listelemiş oluyorum. Eksik olan şey, tarihler "dd.mm.yyyy" formatında sıralanmıyor. Bunu nasıl yapabilirim. ctrl + e ile userform13 açılmakta.
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Diz fonksiyonundaki

If Dizim(i, Stn) > Dizim(j, Stn) Then

satırını

If CDate(Dizim(i, Stn)) > CDate(Dizim(j, Stn)) Then

Olarak değiştirip dener misiniz?

Sorun verilerinizi metin olarak formatladığınız için oluyor, Cdate ile tarihe çeviriyoruz.
 

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
641
Excel Vers. ve Dili
excel 2010

excel 2013
Altın Üyelik Bitiş Tarihi
06-08-2025
Diz fonksiyonundaki

If Dizim(i, Stn) > Dizim(j, Stn) Then

satırını

If CDate(Dizim(i, Stn)) > CDate(Dizim(j, Stn)) Then

Olarak değiştirip dener misiniz?

Sorun verilerinizi metin olarak formatladığınız için oluyor, Cdate ile tarihe çeviriyoruz.

Teşekkürler Yusuf bey,

Fonksiyon kısmında dediğiniz gibi düzeltme yaptım ve istediğim sonucu veriyor. Fonksiyon kısmında çözüm aramak aklıma gelmemişti.
 

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
641
Excel Vers. ve Dili
excel 2010

excel 2013
Altın Üyelik Bitiş Tarihi
06-08-2025
Diz fonksiyonundaki

If Dizim(i, Stn) > Dizim(j, Stn) Then

satırını

If CDate(Dizim(i, Stn)) > CDate(Dizim(j, Stn)) Then

Olarak değiştirip dener misiniz?

Sorun verilerinizi metin olarak formatladığınız için oluyor, Cdate ile tarihe çeviriyoruz.

Yusuf Bey, aynı dosya ile ilgili farklı bir destek rica edebilir miyim.

İlgili listbox üzerinde bir bakiye sütunu oluşturmak istiyorum. Listboxda şuan 8 mevcut kolan var, bunlar excel sayfasından gelmekte, 9 olarak yeni bir kolana bakiye sütunu nasıl eklenebilir.

exceldeki hücreye =EĞER(EMETİNSE(I1);G2-H2;G2-H2+I1) şeklinde formül ile istediğimi yapabiliyorum. Vba da nasıl yapabilirim acaba.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Bilemedim maalesef.
 

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
641
Excel Vers. ve Dili
excel 2010

excel 2013
Altın Üyelik Bitiş Tarihi
06-08-2025
Merhaba,

Açtığım konu ile ilgili olarak aynı soruyu sormak zorundayım ama sebebi kodlarda değişiklik olmasından. Anlaşılabilmesi açısından açıklama yapayım. Konuyu ilk açtığımda istediğim listbox1 üzerindeki Tarih sütununu sıralatmaktı. Bunu yaptıktan sonra aklıma bakiye adında bir sütun eklemek geldi ve listbox1 e bir sütun daha eklemiş oldum. Bakiye sütununu oluşturabilmek amacı ile araştırma yaparken bir örnek buldum ve bunu kendi dosyama ekledim. Ancak yine başa dönmüş oldum. Çünkü mevcut kodlar ile tarih sıralaması yaptırırsam bu sefer bakiyeler doğal olarak bozulmakta. Sebebi ise sıralama işleminin bakiye sütunu oluştuktan sonra oluşması.

Kısaca Userform13 üzerindeki dosyamda listbox1de hem eskiden yeniye tarih sıralaması olacak hem de bakiyelerin düzgün yürüdüğü bir düzenleme yapmak mümkün mü. Verilerin alındığı sayfa üzerinde tarih sıralaması yaptırarak bunu çözebilirim ama kayıt düzeni açısından pek hoş değil. Dosyamdaki userform13 altındaki kodları derleme olarak oluşturdum. Açıkcası çok fazla anlayabilmiş değilim. Mantığını anlamaya çalışmaktayım.

Bakiye sütunu ile ilgili bulduğum çözümün orjinal dosyasınıda ufak bir düzenleme ile ayrıca ekliyorum.
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Listbox1'in kodlarını aşağıdakilerle değiştirip dener misiniz?

PHP:
Private Sub ComboBox1_change()
'On Error Resume Next
ListBox1.ColumnCount = 98
ListBox1.ColumnWidths = "30;60;180;60;50;100;50;50;50"

Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(1 To 12, 1 To 1)
With Worksheets("Alış")
    Me.ListBox1.Clear
    If .FilterMode Then .ShowAllData
    Set k = .Range("C2:C65536").Find(ComboBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 12, 1 To a)
            For j = 1 To 12
                myarr(j, a) = .Cells(k.Row, j).Value
            Next j
            Set k = Range("C2:C65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = myarr
        
    End If
End With

' tarihe göre sıralama yaptırmakta
ListBox1.List = Diz(ListBox1.List, TextBox4.Value)
For fark = 0 To ListBox1.ListCount - 1
    If fark = 0 Then
        ListBox1.List(fark, 8) = ListBox1.List(fark, 6) * 1 - ListBox1.List(fark, 7) * 1
    Else
        ListBox1.List(fark, 8) = ListBox1.List(fark, 6) * 1 - ListBox1.List(fark, 7) * 1 + ListBox1.List(fark - 1, 8)
    End If
Next

Dim i As Long
Dim borctoplami As Double
For i = 0 To ListBox1.ListCount - 1
        borctoplami = ListBox1.List(i, 6) + borctoplami
Next i
TextBox1 = Format(borctoplami, "#,##0.00")

Dim z As Long
Dim alacaktoplami As Double
For z = 0 To ListBox1.ListCount - 1
        alacaktoplami = ListBox1.List(z, 7) + alacaktoplami
Next z
TextBox2 = Format(alacaktoplami, "#,##0.00")

TextBox3 = Format(borctoplami - alacaktoplami, "#,##0.00")

End Sub
 

walabi

Altın Üye
Katılım
22 Eylül 2012
Mesajlar
641
Excel Vers. ve Dili
excel 2010

excel 2013
Altın Üyelik Bitiş Tarihi
06-08-2025
Listbox1'in kodlarını aşağıdakilerle değiştirip dener misiniz?

PHP:
Private Sub ComboBox1_change()
'On Error Resume Next
ListBox1.ColumnCount = 98
ListBox1.ColumnWidths = "30;60;180;60;50;100;50;50;50"

Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(1 To 12, 1 To 1)
With Worksheets("Alış")
    Me.ListBox1.Clear
    If .FilterMode Then .ShowAllData
    Set k = .Range("C2:C65536").Find(ComboBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 12, 1 To a)
            For j = 1 To 12
                myarr(j, a) = .Cells(k.Row, j).Value
            Next j
            Set k = Range("C2:C65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = myarr
       
    End If
End With

' tarihe göre sıralama yaptırmakta
ListBox1.List = Diz(ListBox1.List, TextBox4.Value)
For fark = 0 To ListBox1.ListCount - 1
    If fark = 0 Then
        ListBox1.List(fark, 8) = ListBox1.List(fark, 6) * 1 - ListBox1.List(fark, 7) * 1
    Else
        ListBox1.List(fark, 8) = ListBox1.List(fark, 6) * 1 - ListBox1.List(fark, 7) * 1 + ListBox1.List(fark - 1, 8)
    End If
Next

Dim i As Long
Dim borctoplami As Double
For i = 0 To ListBox1.ListCount - 1
        borctoplami = ListBox1.List(i, 6) + borctoplami
Next i
TextBox1 = Format(borctoplami, "#,##0.00")

Dim z As Long
Dim alacaktoplami As Double
For z = 0 To ListBox1.ListCount - 1
        alacaktoplami = ListBox1.List(z, 7) + alacaktoplami
Next z
TextBox2 = Format(alacaktoplami, "#,##0.00")

TextBox3 = Format(borctoplami - alacaktoplami, "#,##0.00")

End Sub

Yusuf Bey,

Çok teşekkürler, istediğim gibi olmuş görünüyor.
 
Üst