Baska bir listedeki verileri tekrarsız olarak yeni bir listeye alma

[cevrens]

Merhabalar,

Herkese once tesekkurler,sizlerin sayenizde hergecen gun excel fonksiyon ve makro calısmalarında kendimizi gelistiriyoruz hemde islerimizi ciddi anlamda kolaylastırıyoruz. Uzerinde calıstıgım bir tablom var. Ordan bir kesiti sizinle paylasmak istiyorum. arsiv orneklerini de inceledim ama tam olarak istedigime ulasamadım.

Tabloya gore ''SK2012'' sayfasındaki sarı renkli B kolonunda bulunan acenta listesini (tekrarsız bir sekilde) ozet tablo olarak ''SKAGENCIES'' sayfasındaki sarı renkli F4 hucresinden asagıya dogru sıralamak istiyorum. Bununla ilgili bir ornegi uyarlamaya calıstım. CommandButton olusturup istege gore hucre secerek bu sıralamayı yaptırmak istedim ama sanırım bir sorun var.

Yardımlarınız icin tesekkur ederim.

 

[Ömer BARAN]

SK2012 sayfasındaki listenin B sütunundaki firma isimlerinin olduğu alanı seçin, seçiliyken formül çubuğunun sol tarafındaki hücre adının görüntülendiği alana " liste " yazın, sonra aşağıdaki formülü diğer sayfa F4 hücresine yapıştırıp hücre içindeyken Ctrl+Alt+Enter tuşlarına birlikte basın (böylece dizi formülü oluşacak), son olarak o hücreyi aşağı doğru kopyalayınız.

 

[cevrens]

SK2012 sayfasındaki listenin B sütunundaki firma isimlerinin olduğu alanı seçin, seçiliyken formül çubuğunun sol tarafındaki hücre adının görüntülendiği alana " liste " yazın, sonra aşağıdaki formülü diğer sayfa F4 hücresine yapıştırıp hücre içindeyken Ctrl+Alt+Enter tuşlarına birlikte basın (böylece dizi formülü oluşacak), son olarak o hücreyi aşağı doğru kopyalayınız.

Omer Bey tam olarak anlayamadım,asagıdaki formul derken bir formul goremiyorum.Ve sunu da belirteyim aslıda bu tablonu sadece cok kucuk bir kesiti ,daha bircok formulasyonlar var,epey agırlastı zaten ,bu nedenle formul kullanarak degil,mevcut basladıgım makro ile bu sorunumu cozmek istiyorum.
Bu konuda yardımcı olabilirmisiniz ?

 

[Ömer BARAN]

Formülü eklemeyi unutmuşum, buyurun.

=EĞER(EHATALIYSA(İNDİS(liste;KAÇINCI(0;EĞERSAY($F$3:F3;liste);0)))=DOĞRU;"";İNDİS(liste;KAÇINCI(0;EĞERSAY($F$3:F3;liste);0)))

 

[ÖmerBey]

Deneyiniz...

Sub Benzersiz()
Dim s1, s2, x, a
Set s1 = Sheets("SK2012")
Set s2 = Sheets("SK AGENCIES")
x = 4
For a = 5 To s1.Range("B65500").End(3).Row
    If WorksheetFunction.CountIf(s1.Range("B5:B" & a), s1.Cells(a, "B")) = 1 Then
        s2.Cells(x, "F") = s1.Cells(a, "B")
        x = x + 1
    End If
Next
s2.Range("F" & x & ":F65500").ClearContents
End Sub

 

[cevrens]

Destek ekibine çok teşekkür ediyorum.Mucit77'nin yardımı ile bu sorunum çözüldü.Ömer hocam size de teşekkürler fonksiyon için ama dedigim gibi makro ile yapmak istiyordum. Bir sorum daha var ama konu başlıkları karışmasın diye tekrar yeni konu açacagım...
Kolay gelsin.

 

[TUNCA ERSİN]

Sy. @ÖmerBey ;

Hocam peki buna koşul koyabilir miyiz.

Örneğin ;
H sütununda Backoffice koşuluna göre benzersiz olanlarını getirebilirmiyiz.

CA KARIBIK - ING. MICHAL RIECICKY	Backoffice
LEA CA	Backoffice
OREX TRAVEL S.R.O. KOSICE	B2B
OREX TRAVEL S.R.O.BRATISLAVA	B2B
OREX TRAVEL S.R.O.BRATISLAVA	Backoffice
CK ZLATKA S.R.O.	B2B
LG TRADE S.R.O.	Backoffice
DOVOLENKAREN KAROL KOLACNY	Backoffice
LG TRADE S.R.O.	B2B
CK ZLATKA S.R.O.	Backoffice
DOVOLENKAREN KAROL KOLACNY	B2B
TURSLOV S.R.O.	Backoffice
OREX TRAVEL S.R.O. BANSKA	Backoffice
JAN LUPTAK CA	B2B
LENKA	B2B

 

[veyselemre]

Hocam peki buna koşul koyabilir miyiz.

Sub test()

    Dim veri, i&
    With Sheets("SK2012")
        veri = .Range("B5:H" & .Cells(6001, "H").End(3).Row).Value
    End With

    With CreateObject("Scripting.Dictionary")
        For i = LBound(veri) To UBound(veri)
            If veri(i, 7) = "Backoffice" Then
                .Item(veri(i, 1)) = Null
            End If
        Next i
        veri = WorksheetFunction.Transpose(.keys)
    End With

    With Sheets("SK AGENCIES")
        .Range("F4:F" & .Rows.Count).ClearContents
        .Range("F4").Resize(UBound(veri)).Value = veri
    End With

End Sub

Sub test()

    Dim rs As Object
    Set rs = CreateObject("ADODB.Recordset")
    With Sheets("SK AGENCIES")
        .Range("F4:F" & .Cells(Rows.Count, 6).End(xlUp).Row).ClearContents

        rs.Open "SELECT DISTINCT F1 FROM [SK2012$B5:H] WHERE F1 IS NOT NULL AND F7='Backoffice' ORDER BY F1", _
                "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0 Xml;HDR=NO';" & _
                "Data Source=" & ActiveWorkbook.FullName

        .Range("F4").CopyFromRecordset rs
        rs.Close
    End With

End Sub

 

[TUNCA ERSİN]

Sy. @veyselemre ;

Hocam F1 hücresine koşulu yazdığımız zaman gelmesi için ne yapmamız gerekiyor.
Teşekkür ederim.

 

[TUNCA ERSİN]

Deneyiniz...

Sub Benzersiz()
Dim s1, s2, x, a
Set s1 = Sheets("SK2012")
Set s2 = Sheets("SK AGENCIES")
x = 4
For a = 5 To s1.Range("B65500").End(3).Row
    If WorksheetFunction.CountIf(s1.Range("B5:B" & a), s1.Cells(a, "B")) = 1 Then
        s2.Cells(x, "F") = s1.Cells(a, "B")
        x = x + 1
    End If
Next
s2.Range("F" & x & ":F65500").ClearContents
End Sub

Ömer Hocam ;

Kod çok güzel çalışıyor . Ama Biraz Zaman alıyor. Hızlanması için bir şey yapmak gerekiyor. Veri Sayfası Yirmi Bin satır elli sütun Teşekkür ederim.