listboxta belirli bir kolondaki verileri sayma

[enes2000eren]

slm.arkadaşlar kırmızı olan bölüm çalışma kitabında
ilçemem sayfasında ve ap1 hücresinde yazılı ise verileri diğer (başka) sayfadan listboxa aldırdıktan sonra listboxın 7. kolonunda kaç adet olduğunu nasıl saydırabilirim.(sayma işlemi listbox ta olacak)
kod aşağıdaki gibi dir
ÜCRETLİ.Text = WorksheetFunction.CountIf(Range("G:G"), "Ücretli")

 

[Husgvarna]

slm.arkadaşlar kırmızı olan bölüm çalışma kitabında
ilçemem sayfasında ve ap1 hücresinde yazılı ise verileri diğer (başka) sayfadan listboxa aldırdıktan sonra listboxın 7. kolonunda kaç adet olduğunu nasıl saydırabilirim.(sayma işlemi listbox ta olacak)

Listeye verileri getiren kodların altına ekleyerek:
Şöyle deneyiniz.

'........
'............
ÜCRETLİ.Text = 0
        For a = 0 To ListBox1.ListCount - 1
        If ListBox1.List(a, 7) = Sheets("İLÇEMEM").[AP1].Value Then ÜCRETLİ.Text = ÜCRETLİ.Text + 1
        Next

End Sub

 

[enes2000eren]

sn.Husgvarna .dediğinizi yaptım ama saydırma işlemi olmuyor.text "0" olarak görünüyor.

 

[enes2000eren]

Slm.arkadaşlar dosya ekledim.istediğim listbox verileri aldıktan sonra "okul"sayfasındaki a-e-f- sütunlarındaki verileri ayrı ayrı listboxta saydırtmak.
"erkek-kadın-sözleşmeli-kadrolu-ücretli-"textboxları
1-mesela "okul" sayfasındaki
e sütunundaki e2 hücresini ve e3 hücresini
f sütunundaki f2 hücresini ,f3 hücresini ve f4 hücresini listboxın içindeki verilerde saydırtmak.(bu işlemi "1. Sıra texboxlarda"yapacak.
2-aynı şekilde 2. Sıra textboxlarda süzme işlemi yapıldıktan sonra kalanları saydırtmak.(formun üstündeki textboxlar süzme işlemi yapıyor)

 

[Husgvarna]

"Initialize" altındaki kodları aşağıdaki gibi;

 For a = 0 To ListBox1.ListCount - 1
        If ListBox1.List(a, 6) = Sheets("OKUL").[F4].Value Then ÜCRETLİ111.Text = Val(ÜCRETLİ111) + 1
        If ListBox1.List(a, 6) = Sheets("OKUL").[F2].Value Then KADROLU111.Text = Val(KADROLU111) + 1
        If ListBox1.List(a, 6) = Sheets("OKUL").[F3].Value Then SÖZLEŞMELİ111.Text = Val(SÖZLEŞMELİ111) + 1
        If ListBox1.List(a, 21) = Sheets("OKUL").[E2].Value Then ERKEK111.Text = Val(ERKEK111) + 1
        If ListBox1.List(a, 21) = Sheets("OKUL").[E3].Value Then KADIN111.Text = Val(KADIN111) + 1
        Next

"TextBox1_Change" bölümünü aşağıdaki gibi değiştirin.

Private Sub TextBox1_Change()
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""

Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(1 To 25, 1 To 1)
With Worksheets("İLÇEMEM")
    Me.ListBox1.Clear
    'Show all records of Database on Sheet1
    If .FilterMode Then .ShowAllData
    Set k = .Range("A2:A65536").Find(TextBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adrs = k.Address
        Do
            a = a + 1
            ReDim Preserve myarr(1 To 25, 1 To a)
            For j = 1 To 25
                myarr(j, a) = .Cells(k.Row, j).Value
            Next j
            Set k = Range("A2:A65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adrs
        ListBox1.Column = myarr
    End If
End With


[COLOR="#ff0000"]If TextBox1 = Empty Then Exit Sub
ÜCRETLİ111.Text = ""
KADROLU111.Text = ""
SÖZLEŞMELİ111.Text = ""
ERKEK111.Text = ""
KADIN111.Text = ""
For a = 0 To ListBox1.ListCount - 1
        If ListBox1.List(a, 6) = Sheets("OKUL").[F4].Value Then ÜCRETLİ111.Text = Val(ÜCRETLİ111) + 1
        If ListBox1.List(a, 6) = Sheets("OKUL").[F2].Value Then KADROLU111.Text = Val(KADROLU111) + 1
        If ListBox1.List(a, 6) = Sheets("OKUL").[F3].Value Then SÖZLEŞMELİ111.Text = Val(SÖZLEŞMELİ111) + 1
        If ListBox1.List(a, 21) = Sheets("OKUL").[E2].Value Then ERKEK111.Text = Val(ERKEK111) + 1
        If ListBox1.List(a, 21) = Sheets("OKUL").[E3].Value Then KADIN111.Text = Val(KADIN111) + 1
        Next[/COLOR]
End Sub

Kırmızı bölümü;

 Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

End Sub

İçine de yazabilirsiniz.

 

[enes2000eren]

sn.Husgvarna .dediğinizi yaptım ama saydırma işlemi olmuyor.İSTERSENİZ DOSYA ÜZERİNDE BİR DENEYİN.İNŞALLAH HATA BENDEN KAYNAKLANMIYORDUR.AMA OLMADI.

 

[enes2000eren]

ücretli111 texti listboxa her tıklamada katları şeklinde artıyor

 

[enes2000eren]

arkadaşlar bir yol yok mu?

 

[Husgvarna]

Kodları ek dosya ya uyarlamaya çalıştım:

 

[enes2000eren]

sn.Husgvarna .çok teşekkürler.