Mükerer Kayıt Sayısı ve Listboxta Gösterme

[sipkam]

Merhabalar,

Ekteki gibi bir sipariş listesindeki değerleri form içinde listboxta göstermek istiyoruz.

Bu alışveriş listesine sürekli yeni kayıt eklediğimizde userformdaki listbox güncellenmesi gerekiyor...

Örnek dosya ve ekran görüntüsü ektedir. Teşekkürler

 

[Vedat Özer]

Merhabalar,

Ekteki gibi bir sipariş listesindeki değerleri form içinde listboxta göstermek istiyoruz.

Bu alışveriş listesine sürekli yeni kayıt eklediğimizde userformdaki listbox güncellenmesi gerekiyor...

Örnek dosya ve ekran görüntüsü ektedir. Teşekkürler

Selamlar,

User forma kodları ekleyemedim ama istemiş oldugunuz bilgileri Sheeet 2'de göstermektedir.

Option Explicit
 
Sub SiralaSay()
Dim S1 As Worksheet, S2 As Worksheet
Dim i As Long, son As Long, son1 As Long, sat As Long
 
Set S1 = Sheets("Sheet1"): Set S2 = Sheets("Sheet2")
 
Application.ScreenUpdating = False
 
son = S1.[a65536].End(3).Row
S2.Range("A2:b65536").ClearContents
S2.Range("A:b").Borders.LineStyle = 0
 
sat = 1
For i = 3 To son
    If WorksheetFunction.CountIf(S1.Range("a3:a" & i), S1.Cells(i, "a")) = 1 Then
        sat = sat + 1
        S2.Cells(sat, "A") = S1.Cells(i, "a")
    End If
Next i
 
son1 = S2.[a65536].End(3).Row
 
For i = 2 To son1
    S2.Cells(i, "B") = WorksheetFunction.CountIf(S1.Range("a1:a" & son), S2.Cells(i, "A")) & " Sipariş"
 
 
 
Next i
 
Application.ScreenUpdating = True
End Sub

Umarım işinize yarar.

Kodları Sayın Ömer beyin çalışmaların alıp birazcık düzeltmeler yaptım

 

[Husgvarna]

Eklediğiniz resime göre; listede bir sutün var.

Private Sub UserForm_Initialize()
ListBox1.AddItem Cells(1, 1) & "     Spariş Adedi"
For a = 1 To Cells(65536, 1).End(xlUp).Row
b = WorksheetFunction.CountIf(Range("a2:a65000"), Cells(a, 1))
If WorksheetFunction.CountIf(Range("a2:a" & a), Cells(a, 1)) = 1 Then
If b > 1 Then ListBox1.AddItem Cells(a, 1).Value & "       " & b
End If: Next
End Sub

 

[sipkam]

Teşekkürler. Tam istediğim gibi.

Peki listbox'a eklerken en fazla sipariş alanı en üstte nasıl ekletebilirim?

 

[sipkam]

Teşekkürler Vedat Özer bey, işime çok yaradı..

kodunuzda Sheet2 de sıralanan değerli büyükten küçüğe sürekli nasıl güncelleyebilriim. direk makro içinden?

İyi Çalışmalar