• DİKKAT

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

Şartlı Veri Aldırmak..

  • Konbuyu başlatan Konbuyu başlatan HD1975
  • Başlangıç tarihi Başlangıç tarihi
Katılım
13 Şubat 2009
Mesajlar
289
Excel Vers. ve Dili
office 2003
Merhaba ;

Aşağıdaki kodda bir şarta ihtiyacım var;

Kod, "t002" sayfasındaki verileri alıp Listwiev2'ye yüklüyor.
T002 Sayfasının "T" sütununda olan verilerden aynısı "VERİS" sayfasının "T"
sütunda var ise bunu listwiev2'ye getirmesin.

Private Sub ListeGuncelle3()
X = 0
Set Sh = Sheets("T002")
son = Sh.Cells(65536, 1).End(xlUp).Row

With ListView2
.ListItems.Clear

For i = 2 To son

aranan1 = ""
aranan2 = ""
For N = 1 To 3

If Controls("ComboBox" & N + 5) <> "" Then

If OptionButton1.Value = True Then
If N = 1 Then
aranan1 = aranan1 & UCase(Mid(Sh.Cells(i, 1).Value, 1, Len(ComboBox6)))
Else
aranan1 = aranan1 & UCase(Mid(Sh.Cells(i, N).Value, 1, Len(Controls("ComboBox" & N + 5).Value)))
End If
End If

If OptionButton2.Value = True Then
If N = 1 Then
aranan1 = aranan1 & UCase(Sh.Cells(i, 1).Value)
Else
aranan1 = aranan1 & UCase(Sh.Cells(i, N).Value)
End If
End If
aranan2 = aranan2 & UCase(Controls("ComboBox" & N + 5))
End If

Next N

aranan1 = UCase(Replace(Replace(aranan1, "I", "İ"), "i", "I"))
aranan2 = UCase(Replace(Replace(aranan2, "I", "İ"), "i", "I"))

If aranan1 = aranan2 Then


X = X + 1
'.ListItems.Add , , i
.ListItems.Add , , Sh.Cells(i, 1)
With .ListItems(X).ListSubItems

For r = 2 To 26
.Add , , Sh.Cells(i, r)
Next

End With

End If
Next i

End With
Set Sh = Nothing
End Sub


Saygılar..
 
Geri
Üst