Listview'de Veri Listeleme

[seddur]

Merhabalar.Ekli dosyada bir listview çalışması yapılacak.Şöyleki;"Veri" sayfasında "A" sutununda tarihler,"B-C-D-E-F-G-H-I" sutunlarında isimler var.Listview 1.sutununa kaçıncı görüşme olduğu (1.Görüşme,2.Görüşme şeklinde),2. sutuna ise tarihler listelenecek.Listeleme textbox'a girilen isme göre yapılacak.En eski tarihli olan 1.görüşme olarak varsayılacak.Toplam görüşme sayısı 100 olarak varsayılabilir.Userform "Randevu" sayfasındadır..Yardımlarınız için Teşekkür Ediyorum.

 

[seddur]

Aşağıdaki kodu yazdım ama ekran görüntüsünde gözüktüğü gibi sıfırıncı kolon 1.görüşme,2.görüşme şeklinde yazacağı yerde hatalı sonuç veriyor.Listview 1. kolonunda ismin kayıtlı olduğu satırdaki "A"sutununda bulunan tarih, sıfırıncı sutunda ise 1.görüşme,2.görüşme şeklinde tarih sayısı kadar artan sırada listeleme yapacak.

Dim i As Long
Dim s As Worksheet
Dim a As Long
Dim k As Long
With UserForm3.ListView1
For i = 1 To 10
Set s = Sheets("Veri")
For a = 1 To s.Cells(Rows.Count, "a").End(xlUp).Row
If Sheets("Veri").Range("B" & a).Text = UserForm3.TextBox1 Then 'veriler "B:I" kolon aralığında buna göre satır düzeltilecek
k = CDate(s.Cells(a, 1))
.ListItems.Add , , i & "." & "Görüşme"
'Set List = .ListItems.Add, , i & "." & "Görüşme"
ListView1.ListItems.Add.SubItems(1) = CDate(k)
End If
i = i + 1
Next: Next
End With

 

[ÖmerFaruk]

Şu şekilde olacaktı sanırım. Denemeden yazıyorum. Kontrol edin lütfen.

ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Add , , CDate(k)

 

[seddur]

Aşağıdaki kod listview1 1.kolonunda isme karşılık gelen "A" sutunundaki tarihi veriyor ama hep aynı tarihi veriyor.Daha alt satırlardaki aynı isimlere denk gelen tarihleri vermiyor.Bu konuda yardımcı olabilirmisiniz?


With UserForm3.ListView1
On Error Resume Next
For i = 1 To 25
Set s = Sheets("Veri")
Set Bul = s.Range("A:I").Find(TextBox1, , , xlWhole)
If Not Bul Is Nothing Then
Adres = Bul.Address
If s.Cells(Bul.Row, "B:I") = TextBox1 Then
k = s.Cells(Bul.Row, "a")

.ListItems.Add , , i & "." & "Görüşme"
ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Add , , CDate(k)

End If: End If
Next:
End With

 

[Ziynettin]

Mevcut kodları silin ve ekli kodları deneyin.

Dim dc As Object, v()
Private Sub CommandButton1_Click()
    ListView1.ListItems.Clear
    aranan = TextBox1.Text
    deg = Split(dc(aranan), "|")
    For i = 1 To UBound(deg)
        ListView1.ListItems.Add , , i & ". Görüşme"
        ListView1.ListItems(i).SubItems(1) = v(deg(i), 1)
    Next i
End Sub

Private Sub UserForm_Activate()
    With UserForm1.ListView1
        UserForm1.BackColor = RGB(0, 102, 102)
        ListView1.BackColor = RGB(23, 60, 89)
        ListView1.ForeColor = RGB(0, 0, 0)
        .Font.Name = calibri
        .Font.Bold = True
        .ForeColor = RGB(255, 255, 255)
        .Font.Size = 11
        .FullRowSelect = True
        .View = lvwReport
         .Gridlines = True
        .ColumnHeaders.Add , , "GÖRÜŞME", 90, lvwColumn
        .ColumnHeaders.Add , , "TARİH", 100, lvwColumn
    End With
    
    Set s = Sheets("Veri")
    son = s.Cells(Rows.Count, 1).End(3).Row
    sut = s.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    v = s.Range("A1:I" & son).Value
    Set dc = CreateObject("scripting.dictionary")
    For i = 2 To UBound(v)
        For j = 2 To UBound(v, 2)
            If v(i, j) <> "" Then
                dc(v(i, j)) = dc(v(i, j)) & "|" & i
            End If
        Next j
    Next i
End Sub

 

[seddur]

Aşağıdaki satır için UBound üzerinde Expected array şeklinde hata veriyor

For i = 1 To UBound(deg)

 

[Ziynettin]

Ekli dosyanıza göre sorun yok.

 

[seddur]

Haklısınız Paylaştığınız dosyanın VBA sayfasından userform'u kopyalamak zorunda kaldım.son zamanlarda excel dosyalarında sürekli hatalar veriyor örneğin out of memory hatasını sıklıkla vermeye başladı.Yeniden office programını yüklemek mi lazım anlayamadım.Katkınız için Teşekkür ederim.