• DİKKAT

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

Listwıevde metne göre toplama

A

arzum2000

Katılım
8 Kasım 2009
Mesajlar
68
Excel Vers. ve Dili
2003
Ekteki arıza adlı dosyamda A ile J sütunu arasında a,c,e,ı sütunlarındaki metne göre takvimde seçilen 2 tarih arasına göre b,d,f,g,h sütunlarını topaltmak istiyorum.Aynı olan metinler yan sütunda dahi olsa toplanacak ve listwıevde1 görüntülenecek.
2.isteğim ise K ile O sütunu arasındaki veriler checkboxtan yapılan seçime göre kullanılan metrajları ve adetleri toplatmak ve listwıev2 de görüntülemek istiyorum.Örneğin checkbox1 işaretlediğimde firma adına göre F ve M sütunlarını ayrı ayrı toplayacak.checkbox2 yi işaretlediğimde aynı olanları bulacak ve L sütunundaki verilere göre M ve N sütununu topayacak.Checkbox3 işaretlediğimde ise firma adına göre adetleri toplayacak aynı firmadan olanları üst üste o sütunundaki nedenlere göre toplamasını istiyorum.Teşekkür ediyorum.Hoşçakalın.
 

Ekli dosyalar

Sorunuzun ilk bölümünü(listview1) yaptım.İki tarih arasında olan ve az olanları listeliyor.Bunu belirtmemiştiniz.Ben öyle yaptım.
2nci bölümünü anlamadım.
Dosyanız ektedir.:cool:
Kod: 
Private Sub CommandButton1_Click()
Dim deg As Integer, sat As Long, i As Byte
Dim z As Object, vkey
ListView1.ListItems.Clear
Set z = CreateObject("Scripting.Dictionary")
deg = DTPicker2.Value - DTPicker1.Value
With Sheets("Sayfa1")
    For i = 1 To 10 Step 2
        If .Cells(65536, i).End(xlUp).Row > sat Then sat = _
        .Cells(65536, i).End(xlUp).Row
    Next i
    For i = 1 To 10 Step 2
        For k = 10 To sat
            If .Cells(k, i).Value <> "" And .Cells(k, i + 1).Value <= deg Then
                If Not z.exists(.Cells(k, i).Value) Then
                    z.Add .Cells(k, i).Value, .Cells(k, i + 1).Value
                    Else
                    z.Item(.Cells(k, i).Value) = z.Item(.Cells(k, i).Value) _
                    + .Cells(k, i + 1).Value
                End If
            End If
        Next
    Next
End With
For Each vkey In z
    x = x + 1
    ListView1.ListItems.Add , , vkey
    ListView1.ListItems(x).SubItems(1) = z.Item(vkey)
Next
End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
ListView1.View = lvwReport
ListView1.ColumnHeaders.Add , , "İSİM", 150
ListView1.ColumnHeaders.Add , , "SÜRE", 100
End Sub
 

Ekli dosyalar

Evren bey

Cevabınız için teşekkür ediyorum.Yanlız dalgınlıkla A sütununa tarih eklemeyi unutmuşum,kusura bakmayın.Takvim tarihi burdan seçecekti.Tekrar bakmanızı rica edeceğim.
Diğer soru aslında çok basit ben diğer soruyu sayfa 2 ye aktardım diğeriyle karışmasın diye B sütununda firma isimleri var userform üzerindeki checkbox1 işaretlediğimde userformdaki seçilen 2 tarih aralığına göre B sütunundaki firma adlarına göre D ve E sütunlarındaki rakamları toplayacak.
Userform üzerindeki checkbox2 yi tiklersem bu kez 2 TARİH ARALIĞINDA Firma adını (B sütunu) dikkate almadan C sütunundaki aynı olan rakamlara göre(rakamları metin gibi düşünebiliriz) yine D ve E sütundaki rakamları toplayacak
3.ve son olarakta checkbox3 işaretlersem Takvimden seçilen 2 tarih aralığında F10 DAKİ YIRTILMA B10(HANGİ FİRMADAN) HANGİ TİPTE(C10) KAÇ ADET OLMUŞ(D10) AYNI FİRMA VE TİPTE KAÇ TANE YIRTILMA OLDUĞUNU GÖRMEK İSTİYORUM.Aynı şekilde F sütunundaki diğer nedenlere görede bu şekilde sıralama yapacak.Tekrar teşekkür ediyorum emekleriniz için.
 

Ekli dosyalar

Son düzenleme:
arzum2000' Alıntı:
Cevabınız için teşekkür ediyorum.Yanlız dalgınlıkla A sütununa tarih eklemeyi unutmuşum,kusura bakmayın.Takvim tarihi burdan seçecekti.Tekrar bakmanızı rica edeceğim.
Diğer soru aslında çok basit ben diğer soruyu sayfa 2 ye aktardım diğeriyle karışmasın diye A sütununda firma isimleri var userform üzerindeki checkbox1 işaretlediğimde A sütunundaki firma adlarına göre c ve d sütunlarındaki rakamları toplayacak.
Userform üzerindeki checkbox2 yi tiklersem bu kez Firma adını (a sütunu) dikkate almadan B sütunundaki aynı olan rakamlara göre(rakamları metin gibi düşünebiliriz) yine C ve D sütundaki rakamları toplayacak
3.ve son olarakta checkbox3 işaretlersem E10 DAKİ YIRTILMA A10(HANGİ FİRMADAN) HANGİ TİPTE(B10) KAÇ ADET OLMUŞ(C10) AYNI FİRMA VE TİPTE KAÇ TANE YIRTILMA OLDUĞUNU GÖRMEK İSTİYORUM.Tekrar teşekkür ediyorum emekleriniz için.
Genişletmek için tıkla ...

Bunlar checkbox değilde option buton olması gerekmiyormu.Biliyorsunuz checek box olduğu zaman bütün seçili olanlar dikkate alınacak,yani checkbox sayısı kadar sorgulama yapılacak.Oysa ption button olsalar idi yalnızca bir tane işaretl
olacak ve bir adede göre sorgulama yapılacak.
Tarihi göre ayarladığınıza göre şimdi bakacam.Ama lütfen sorularınızı hazırlarken kafanızda iyice tasarlayın ve sorunuzu o şekilde sorun.Bu şekilde tekrar geri dönmeler soruyu cevaplayan kişiyi bezdiriyorsunarım.Sonra o kişi başka sorularınıza yanıt vermeyebilir!.Bilginize :cool:
 
İlk bölümdeki sorunuzu yaptım.Bir bakın olmuşmu?
Şimdi 2nci bölüme bakacam.:cool:
Kod: 
Private Sub CommandButton1_Click()
Dim sat As Long, i As Byte
Dim z As Object, vkey
ListView1.ListItems.Clear
Set z = CreateObject("Scripting.Dictionary")
With Sheets("Sayfa1")
    For i = 2 To 11 Step 2
        If .Cells(65536, i).End(xlUp).Row > sat Then sat = _
        .Cells(65536, i).End(xlUp).Row
    Next i
    For i = 2 To 11 Step 2
        For k = 10 To sat
            If .Cells(k, i).Value <> "" And .Cells(k, "A").Value >= _
            DTPicker1.Value And .Cells(k, "A").Value <= DTPicker2.Value Then
                If Not z.exists(.Cells(k, i).Value) Then
                    z.Add .Cells(k, i).Value, .Cells(k, i + 1).Value
                    Else
                    z.Item(.Cells(k, i).Value) = z.Item(.Cells(k, i).Value) _
                    + .Cells(k, i + 1).Value
                End If
            End If
        Next
    Next
End With
For Each vkey In z
    x = x + 1
    ListView1.ListItems.Add , , vkey
    ListView1.ListItems(x).SubItems(1) = z.Item(vkey)
Next
End Sub
 

Ekli dosyalar

Tamam 2nci konuyu anladım şimdi onuda yaparım.:cool:
 
Evren bey birinci bölüm tamam çok tşkler 2.bölüm içinde rica ediyorum
 
Dosyanızı yaptım dosyanız ektedir.:cool:
Kod: 
Private Sub CommandButton2_Click()
Dim i As Long, sat As Long, z As Object, n As Long, vkey, myarr()
Dim j As Byte, firma As String, degistirilme As String
Set z = CreateObject("Scripting.Dictionary")
lv.ListItems.Clear
sat = sh.Cells(65536, "A").End(xlUp).Row
firma = UCase(Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ"))
If OptionButton1.Value = True Then
    For i = 1 To lv.ColumnHeaders.Count
        lv.ColumnHeaders.Item(i).Width = 0
    Next i
    lv.ColumnHeaders.Item(1).Width = 170
    lv.ColumnHeaders.Item(1).Text = "FİRMA"
    lv.ColumnHeaders.Item(2).Width = 100
    lv.ColumnHeaders.Item(2).Text = "TİPİ"
    lv.ColumnHeaders.Item(3).Width = 100
    lv.ColumnHeaders.Item(3).Text = "KULLANILAN METRAJ"
    ReDim myarr(1 To 4, 1 To 1)
    n = n + 1
    myarr(1, n) = TextBox1.Text
    For i = 10 To sat
        If sh.Cells(i, "A").Value >= DTPicker1.Value And _
        sh.Cells(i, "A").Value <= Me.DTPicker2.Value And _
        firma = UCase(Replace(Replace(sh.Cells(i, "B").Value, "ı", "I") _
        , "i", "İ")) Then
            myarr(2, n) = myarr(2, n) + sh.Cells(i, "D").Value
            myarr(3, n) = myarr(3, n) + sh.Cells(i, "E").Value
        End If
    Next
End If
'Optionbutton2 çalışıyor
If OptionButton2.Value = True Then
    For i = 1 To lv.ColumnHeaders.Count
        lv.ColumnHeaders.Item(i).Width = 0
    Next i
    lv.ColumnHeaders.Item(1).Width = 170
    lv.ColumnHeaders.Item(1).Text = "TİPİ"
    lv.ColumnHeaders.Item(2).Width = 100
    lv.ColumnHeaders.Item(2).Text = "ADET"
    lv.ColumnHeaders.Item(3).Width = 100
    lv.ColumnHeaders.Item(3).Text = "KULLANILAN METRAJ"
    ReDim myarr(1 To 3, 1 To sat)
    For i = 10 To sat
        If sh.Cells(i, "A").Value >= DTPicker1.Value And _
        sh.Cells(i, "A").Value <= Me.DTPicker2.Value Then
            If Not z.exists(CStr(sh.Cells(i, "C").Value)) Then
                n = n + 1
                z.Add CStr(sh.Cells(i, "C").Value), n
                myarr(1, n) = CStr(sh.Cells(i, "C").Value)
            End If
            myarr(2, z.Item(CStr(sh.Cells(i, "C").Value))) = _
            myarr(2, z.Item(CStr(sh.Cells(i, "C").Value))) + sh.Cells(i, "D").Value
            myarr(3, z.Item(CStr(sh.Cells(i, "C").Value))) = _
            myarr(3, z.Item(CStr(sh.Cells(i, "C").Value))) + sh.Cells(i, "E").Value
        End If
    Next
End If
'OptionButon3 çalışıyor.
If OptionButton3.Value = True Then
    degistirilme = UCase(Replace(Replace(TextBox3.Text, "ı", "I"), "i", "İ"))
    For i = 1 To lv.ColumnHeaders.Count
        lv.ColumnHeaders.Item(i).Width = 0
    Next i
    lv.ColumnHeaders.Item(1).Width = 150
    lv.ColumnHeaders.Item(1).Text = "FİRMA"
    lv.ColumnHeaders.Item(2).Width = 100
    lv.ColumnHeaders.Item(2).Text = "TİPİ"
    lv.ColumnHeaders.Item(3).Width = 100
    lv.ColumnHeaders.Item(3).Text = "ADET"
    lv.ColumnHeaders.Item(4).Width = 100
    lv.ColumnHeaders.Item(4).Text = "DEĞİŞTİRİLME NEDENİ"
    ReDim myarr(1 To 5, 1 To sat)
    For i = 10 To sat
        If sh.Cells(i, "A").Value >= DTPicker1.Value And _
        sh.Cells(i, "A").Value <= Me.DTPicker2.Value And _
        UCase(Replace(Replace(sh.Cells(i, "F").Value, "ı", "I"), "i", "İ")) _
        = degistirilme Then
            If Not z.exists(firma & "-" & CStr(sh.Cells(i, "C").Value)) Then
                n = n + 1
                z.Add CStr(firma & "-" & sh.Cells(i, "C").Value), n
                myarr(1, n) = CStr(sh.Cells(i, "B").Value)
                myarr(2, n) = CStr(sh.Cells(i, "C").Value)
            End If
            myarr(3, z.Item(firma & "-" & CStr(sh.Cells(i, "C").Value))) = _
            myarr(3, z.Item(firma & "-" & CStr(sh.Cells(i, "C").Value))) + sh.Cells(i, "D").Value
            myarr(4, z.Item(firma & "-" & CStr(sh.Cells(i, "C").Value))) = _
            myarr(4, z.Item(firma & "-" & CStr(sh.Cells(i, "C").Value))) + sh.Cells(i, "E").Value
            myarr(5, z.Item(firma & "-" & CStr(sh.Cells(i, "C").Value))) = sh.Cells(i, "F").Value
        End If
    Next
End If
For i = 1 To n
    lv.ListItems.Add , , myarr(1, i)
    For j = 2 To UBound(myarr, 1)
        lv.ListItems(i).SubItems(j - 1) = myarr(j, i)
    Next j
Next i

End Sub
 

Ekli dosyalar

Dosyanızı yaptım 8 numaralaı mesajdan inidrebilirsiniz.:cool:
 
Sadece optionbutton2 işaretlediğimde çalışıyor.diğerleri çalışmıyor.tekrar bakarsanız sevinirim.saygılarımla.
 
arzum2000' Alıntı:
Sadece optionbutton2 işaretlediğimde çalışıyor.diğerleri çalışmıyor.tekrar bakarsanız sevinirim.saygılarımla.
Genişletmek için tıkla ...
Textbox1'e firma adını girmelisiniz.
Textbox3'ede Değiştirilme nedenini girmelisiniz.
Ben şimdi denedim gayet güzel çalışıyor.:cool:
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst