• DİKKAT

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

hücredeki benzer değerleri ayıklama

Katılım
5 Aralık 2008
Mesajlar
2
Excel Vers. ve Dili
2003
herkese selam
başlığı doğrumu yazdım bilmiyorum ama,kaç gündür bununla uğraşıyorum.
yapmak istediğimi ekteki dosyada açıklamaya çalıştım. B ve C hücresesindeki değerleri benzerleri dikkate alarak G ve H hücresine yazsın.
şimdiden teşekkürler.
Ekli dosyayı görüntüle deneme.xls
 
Merhaba,
Veri / Filtre Uygula / Gelişmiş Filtre ile yapılabilir.
 
Dosyanız ektedir.:cool:
Kod:
Option Base 1
Sub teke_indir_59()
Dim z, sat As Long, list(), sat2 As Long, myarr(), n As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("G:H").ClearContents
sat = Cells(Rows.Count, "B").End(xlUp).Row
If sat < 1 Then
    Application.ScreenUpdating = False
    Exit Sub
End If
Set z = CreateObject("Scripting.Dictionary")
list = Range("B1:C" & sat).Value
sat2 = UBound(list)
ReDim myarr(1 To 2, 1 To sat2)
For i = 1 To sat2
    If Not z.exists(list(i, 1) & list(i, 2)) Then
        n = n + 1
        z.Add (list(i, 1) & list(i, 2)), n
        myarr(1, n) = list(i, 1)
        myarr(2, n) = list(i, 2)
    End If
Next i
Erase list: Set z = Nothing
ReDim Preserve myarr(1 To 2, 1 To n)
Range("G1").Resize(n, 2) = Application.Transpose(myarr)
Erase myarr
Application.ScreenUpdating = True
MsgBox "İşlem tammalanmıştır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "B İ T T İ"
End Sub
 

Ekli dosyalar

Mahir kardeş ilgine teşekkür ederim.ama olmadı yada ben yapamadım.Orion1 sanada teşekkür ederim. makrosuz bir çözüm olmasını istiyorum.ornek dosyamda b hücresindeki unp120 profilinin ağırlığı C hücresindeki değerdir.ve bunun gibi bir çok farklı profil ismi ve ağırlığı olacak.istediğim,b hücresindeki farklı profil isimlerini ve ağırlıklarını benzerlerin dikkate alarak g ve h hücresine yazması.inşallah ihtiyacımı anlatabilmişimdir.
 
Geri
Üst