• DİKKAT

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

Listwieve mükerrer kayıt gelmesin ?

  • Konbuyu başlatan Konbuyu başlatan HD1975
  • Başlangıç tarihi Başlangıç tarihi
H

HD1975

Katılım
13 Şubat 2009
Mesajlar
289
Excel Vers. ve Dili
office 2003
Aşağıdaki kodda 'ÇİLEK' sayfasındaki "d" sütununda bulunan verilere mükerrer
kontrolü yapıp aynı olan kayıları listwieve getirmemesi için gereken düzenlemeyi nasıl yapabilirim.

Saygılar


Private Sub UserForm_Initialize()
Dim hwnd, i, K, A, N, L As Long
hwnd = FindWindowA(vbNullString, Me.Caption)
SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) Or &H20000
With bul
'.Height = Application.Height
'.Width = Application.Width
End With

For i = 3 To Sheets("DEĞER").Range("C80").End(3).Row
If Sheets("DEĞER").Cells(i, 3).Value <> Empty Then
ComboBox6.AddItem Sheets("DEĞER").Cells(i, 3).Value
ComboBox10.AddItem Sheets("DEĞER").Cells(i, 3).Value
End If
Next i
For K = 83 To Sheets("DEĞER").Range("D180").End(3).Row
If Sheets("DEĞER").Cells(K, 4).Value <> Empty Then
ComboBox7.AddItem Sheets("DEĞER").Cells(K, 4).Value
End If
Next K

For A = 201 To Sheets("DEĞER").Range("F3500").End(3).Row
If Sheets("DEĞER").Cells(A, 6).Value <> Empty Then
ComboBox8.AddItem Sheets("DEĞER").Cells(A, 6).Value
End If
Next A

For N = 2 To Sheets("ÇİLEK").Range("E10000").End(3).Row
If Sheets("ÇİLEK").Cells(N, 5).Value <> Empty Then
ComboBox3.AddItem Sheets("ÇİLEK").Cells(N, 5).Value
End If
Next N

For L = 83 To Sheets("DEĞER").Range("D180").End(3).Row
If Sheets("DEĞER").Cells(L, 4).Value <> Empty Then
ComboBox9.AddItem Sheets("DEĞER").Cells(L, 4).Value

End If
Next L

i = Empty
K = Empty
A = Empty
N = Empty
L = Empty

Set Sh = Sheets("VERİ")


son = Sh.Cells(65536, 1).End(xlUp).Row
yeni = True
With bul.ListView1
.ListItems.Clear
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
With .ColumnHeaders
.Add , , Sh.Cells(1, 1), 40
.Add , , Sh.Cells(1, 2), 70
.Add , , Sh.Cells(1, 3), 96
.Add , , Sh.Cells(1, 4), 55
.Add , , Sh.Cells(1, 5), 180
.Add , , Sh.Cells(1, 6), 35
.Add , , Sh.Cells(1, 7), 30
.Add , , Sh.Cells(1, 8), 30
.Add , , Sh.Cells(1, 9), 30
.Add , , Sh.Cells(1, 10), 30
.Add , , Sh.Cells(1, 11), 30
.Add , , Sh.Cells(1, 12), 30
.Add , , Sh.Cells(1, 13), 30
.Add , , Sh.Cells(1, 14), 30
.Add , , Sh.Cells(1, 15), 40
.Add , , Sh.Cells(1, 16), 40
.Add , , Sh.Cells(1, 17), 40
.Add , , Sh.Cells(1, 18), 40
.Add , , Sh.Cells(1, 19), 40
.Add , , Sh.Cells(1, 20), 1
.Add , , Sh.Cells(1, 21), 100
.Add , , Sh.Cells(1, 22), 40
.Add , , Sh.Cells(1, 23), 40
.Add , , Sh.Cells(1, 24), 40
.Add , , Sh.Cells(1, 25), 40
.Add , , Sh.Cells(1, 26), 40
.Add , , Sh.Cells(1, 27), 40
.Add , , Sh.Cells(1, 28), 40
.Add , , Sh.Cells(1, 29), 50
.Add , , "Satir", 0
End With
End With
ListeGuncelle

Set Sh = Sheets("ÇİLEK")
son = Sh.Cells(65536, 1).End(xlUp).Row
yeni = True
With bul.ListView2
.ListItems.Clear
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
With .ColumnHeaders
.Add , , Sh.Cells(1, 1), 40
.Add , , Sh.Cells(1, 2), 70
.Add , , Sh.Cells(1, 3), 96
.Add , , Sh.Cells(1, 4), 55
.Add , , Sh.Cells(1, 5), 180
.Add , , Sh.Cells(1, 6), 35
.Add , , Sh.Cells(1, 7), 30
.Add , , Sh.Cells(1, 8), 30
.Add , , Sh.Cells(1, 9), 30
.Add , , Sh.Cells(1, 10), 30
.Add , , Sh.Cells(1, 11), 30
.Add , , Sh.Cells(1, 12), 30
.Add , , Sh.Cells(1, 13), 30
.Add , , Sh.Cells(1, 14), 30
.Add , , Sh.Cells(1, 15), 40
.Add , , Sh.Cells(1, 16), 40
.Add , , Sh.Cells(1, 17), 40
.Add , , Sh.Cells(1, 18), 40
.Add , , Sh.Cells(1, 19), 40
.Add , , Sh.Cells(1, 20), 1
.Add , , Sh.Cells(1, 21), 40
.Add , , Sh.Cells(1, 22), 40
.Add , , Sh.Cells(1, 23), 40
.Add , , Sh.Cells(1, 24), 40
.Add , , Sh.Cells(1, 25), 40
.Add , , Sh.Cells(1, 26), 40
.Add , , "Satir", 0

End With
End With

ListeGuncelle1

End Sub
 
Selamlar,

Örnek dosya eklermisiniz.
 
Örnek dosyada "çilek" sayfasındaki verilerden "D" sütunundaki verilere göre
D ile AA sütunu arasındaki verileri esas alıp bu veriler içerisinde tüm sütunlardaki veriler aynı ise listwieev2'ye getirmesin.


Saygılarımla
 

Ekli dosyalar

Selamlar,

"IV" sütununu yardımcı sütun olarak kullandım. Çoklu sütunlarda mükerrerlik kontrolü için en hızlı yöntem budur.

Aşağıdaki kodu denermisiniz.

Kod: 
Sub ListeGuncelle1()
    Set sh = Sheets("ÇİLEK")
    son = sh.Cells(65536, 1).End(xlUp).Row
    sh.Range("IV2") = "=D2&E2&F2&G2&H2&I2&J2&K2&L2&M2&N2&O2&P2&Q2&R2&S2&T2&U2&V2&W2&X2&Y2&Z2"
    sh.Range("IV2").AutoFill Destination:=sh.Range("IV2:IV" & son), Type:=xlFillDefault
    sh.Range("IV2:IV" & son).Value = sh.Range("IV2:IV" & son).Value
    
    With bul.ListView2
        .ListItems.Clear
    
        For i = 2 To son
            On Local Error Resume Next
            Set A = Sheets("veri").Range("t2:t" & Sheets("veri").Range("t65536").End(3).Row).Find(sh.Cells(i, "t").Value, , , 1)
            If A Is Nothing Then
                If WorksheetFunction.CountIf(sh.Range("IV2:IV" & i), sh.Cells(i, "IV")) = 1 Then
                    .ListItems.Add , , sh.Cells(i, 1)
                    x = x + 1
                    With .ListItems(x).ListSubItems
                        .Add , , sh.Cells(i, 2)
                        .Add , , sh.Cells(i, 3)
                        .Add , , sh.Cells(i, 4)
                        .Add , , sh.Cells(i, 5)
                        .Add , , sh.Cells(i, 6)
                        .Add , , sh.Cells(i, 7)
                        .Add , , sh.Cells(i, 8)
                        .Add , , sh.Cells(i, 9)
                        .Add , , sh.Cells(i, 10)
                        .Add , , sh.Cells(i, 11)
                        .Add , , sh.Cells(i, 12)
                        .Add , , sh.Cells(i, 13)
                        .Add , , sh.Cells(i, 14)
                        .Add , , sh.Cells(i, 15)
                        .Add , , sh.Cells(i, 16)
                        .Add , , sh.Cells(i, 17)
                        .Add , , sh.Cells(i, 18)
                        .Add , , sh.Cells(i, 19)
                        .Add , , sh.Cells(i, 20)
                        .Add , , sh.Cells(i, 21)
                        .Add , , sh.Cells(i, 22)
                        .Add , , sh.Cells(i, 23)
                        .Add , , sh.Cells(i, 24)
                        .Add , , sh.Cells(i, 25)
                        .Add , , sh.Cells(i, 26)
                        .Add , , i
                    End With
                End If
            End If
            Set A = Nothing
        Next i
    End With
    Set sh = Nothing
End Sub
 
Gayet iyi ve hızlı çalışıyor.

Teşekkür Ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst