• DİKKAT

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

Listview1 den Listview2 ye benzersiz veri aktarımı

walabi

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

excel 2013
Merhaba, Listview1 den Listview2 ye benzersiz veri listelemek istiyorum. Aşağıda görünen kod ile excel sayfasından listview1 e benzersiz veri listelemesi yapabiliyorum. Bunun benzeri olarak Listview den diğer Listview e benzersiz veri nasıl aktarabilirim. İkinci kod aralığı bununla ilgili yapmaya çalıştığım deneme.

Excel sayfası üzerindeki veriyi aşağıdaki kod ile benzersiz olarak listeleyebiliyorum.

Kod:
Sub Listele()

Dim s1 As Worksheet
Dim s2 As Worksheet

Dim sonsatir As Long
Dim i As Long
Dim x As Long

Set s1 = Sheets("Data")
Set s2 = Sheets("Hesap_Planı")


 
    ListView1.ListItems.Clear '

    For i = 2 To s2.[A65536].End(xlUp).Row
        If s2.Cells(i, "A") <> "" And Len(s2.Cells(i, "A")) = 11 Then
            If WorksheetFunction.CountIf(s2.Range("A2:A" & i), s2.Cells(i, "A").Value) = 1 Then
       
            Set Liste = ListView1.ListItems.Add(, , s2.Cells(i, "A").Value)
            Liste.SubItems(1) = s2.Cells(i, "A").Value
            Liste.SubItems(2) = s2.Cells(i, "B").Value
           
         
            End If
        End If
    Next i
   
End Sub


Aşağıdaki kodu nasıl düzeltmem gerekir. Range("A2:A" & i) aralığını listview e nasıl uyarlayabilirim, çözemedim.

Kod:
Sub Listele2()
Dim i As Long

If ListView1.ListItems.count = 0 Then Exit Sub



 
    ListView2.ListItems.Clear
    For i = 1 To ListView1.ListItems.count
   
       
            'If WorksheetFunction.CountIf(s2.Range("A2:A" & i), s2.Cells(i, "A").Value) = 1 Then
            If WorksheetFunction.CountIf(ListView1.ListItems(i).SubItems(1), ListView1.ListItems(i).SubItems(1)) = 1 Then

       
            Set Liste = ListView2.ListItems.Add(, , ListView1.ListItems(i).SubItems(1))
            Liste.SubItems(1) = ListView1.ListItems(i).SubItems(1)
            Liste.SubItems(2) = ListView1.ListItems(i).SubItems(2)
           
         
            End If
     
    Next i

End Sub
 
Merhaba.
Kod:
Private Sub CommandButton1_Click()
    Dim Bak As Long
    Dim Dict As Object
    Dim Benzersiz As Variant
    Set Dict = CreateObject("Scripting.Dictionary")
    For Bak = 1 To ListView1.ListItems.Count
        If Not Dict.exists(ListView1.ListItems(Bak).Text) Then
            Dict.Add ListView1.ListItems(Bak).Text, ""
        End If
    Next
    ListView2.ListItems.Clear
    For Each Benzersiz In Dict.Keys
        ListView2.ListItems.Add , , Benzersiz
    Next
    MsgBox "Tamamlandı."
End Sub
 
Merhaba.
Kod:
Private Sub CommandButton1_Click()
    Dim Bak As Long
    Dim Dict As Object
    Dim Benzersiz As Variant
    Set Dict = CreateObject("Scripting.Dictionary")
    For Bak = 1 To ListView1.ListItems.Count
        If Not Dict.exists(ListView1.ListItems(Bak).Text) Then
            Dict.Add ListView1.ListItems(Bak).Text, ""
        End If
    Next
    ListView2.ListItems.Clear
    For Each Benzersiz In Dict.Keys
        ListView2.ListItems.Add , , Benzersiz
    Next
    MsgBox "Tamamlandı."
End Sub


Kontrol ediyorum, teşekkürler.
 
Merhaba,

İlk kodunuz zaten ListView1 nesnesine verileri benzersiz yüklemiyor mu?
 
Merhaba.
Kod:
Private Sub CommandButton1_Click()
    Dim Bak As Long
    Dim Dict As Object
    Dim Benzersiz As Variant
    Set Dict = CreateObject("Scripting.Dictionary")
    For Bak = 1 To ListView1.ListItems.Count
        If Not Dict.exists(ListView1.ListItems(Bak).Text) Then
            Dict.Add ListView1.ListItems(Bak).Text, ""
        End If
    Next
    ListView2.ListItems.Clear
    For Each Benzersiz In Dict.Keys
        ListView2.ListItems.Add , , Benzersiz
    Next
    MsgBox "Tamamlandı."
End Sub



Sayın Muzaffer Ali , sizin yazdığınız kodu aşağıdaki şekilde kullandığımda işime yarıyor, ancak şu şekilde yapmam gerekiyor. Sizin yazdığınız kod sanırım tek bir sütun üzerinden işlem yapıyor. Ben ise iki sütun üzerinden işlem yapmak istiyorum. Örneğin, Listview 1 de subitems(14) = Stok Kodu, subitems(13) = Stok Adı . Yani Listview 1 benzersiz bir listeleme yapmak istediğimde stok koduna göre benzersiz listeleme yapmam gerekiyor, ancak Stok Kodu nun yanına Stok Adı da gelmesi gerekiyor. Bu şekilde revize edilebilir mi???


Kod:
Private Sub CommandButton6_Click()


    Dim Bak As Long
    Dim Dict As Object
    Dim Benzersiz As Variant
    Set Dict = CreateObject("Scripting.Dictionary")
    For Bak = 1 To ListView1.ListItems.count
        If Not Dict.exists(ListView1.ListItems(Bak).SubItems(14)) Then
            Dict.Add ListView1.ListItems(Bak).SubItems(14), ""
        End If
    Next
    ListView2.ListItems.Clear
    For Each Benzersiz In Dict.Keys
        ListView2.ListItems.Add , , Benzersiz
    Next
    




End Sub
 
Merhaba,

İlk kodunuz zaten ListView1 nesnesine verileri benzersiz yüklemiyor mu?


İlk yazdığım kod benzersiz listeleme yapıyor , ancak onu örnek olarak gönderdim. Bunun benzeri bir uygulamayı Listview den Listviewe benzersiz şekilde listeleme yapmak için kullanmak istiyorum. Bir userform üzerinde iki adet listview var. Listview1 de benzer olan stoklar var. İkinci listview e bunları benzersiz olarak listelemek istedim.
 
Deneyiniz.
Kod:
Private Sub CommandButton6_Click()

    Dim Bak As Long
    Dim Dict As Object
    Dim Benzersiz As Variant
    Dim Lst As ListItem

    Set Dict = CreateObject("Scripting.Dictionary")
    For Bak = 1 To ListView1.ListItems.Count
        With ListView1.ListItems(Bak)
            If Not Dict.Exists(.SubItems(14) & "||" & .SubItems(13)) Then
                Dict.Add .SubItems(14) & "||" & .SubItems(13), ""
            End If
        End With
    Next
    ListView2.ListItems.Clear
    For Each Benzersiz In Dict.Keys
        Set Lst = ListView2.ListItems.Add(, , Split(Benzersiz, "||")(0))
        Lst.SubItems(1) = Split(Benzersiz, "||")(1)
    Next
    
End Sub
 
Deneyiniz.
Kod:
Private Sub CommandButton6_Click()

    Dim Bak As Long
    Dim Dict As Object
    Dim Benzersiz As Variant
    Dim Lst As ListItem

    Set Dict = CreateObject("Scripting.Dictionary")
    For Bak = 1 To ListView1.ListItems.Count
        With ListView1.ListItems(Bak)
            If Not Dict.Exists(.SubItems(14) & "||" & .SubItems(13)) Then
                Dict.Add .SubItems(14) & "||" & .SubItems(13), ""
            End If
        End With
    Next
    ListView2.ListItems.Clear
    For Each Benzersiz In Dict.Keys
        Set Lst = ListView2.ListItems.Add(, , Split(Benzersiz, "||")(0))
        Lst.SubItems(1) = Split(Benzersiz, "||")(1)
    Next
   
End Sub


Teşekkürler, bu hali ile benim aradığım sonuca ulaşabiliyorum.
 
Geri
Üst