• DİKKAT

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

Iki sütünu karsilastirip diger sutuna olmayani yazmak icin yardim...

E

ehsonunda

Katılım
12 Haziran 2015
Mesajlar
7
Excel Vers. ve Dili
2007 türkçe
Arkadaslar forumda bununla ilgili onlarca konu var fakat istedigim sey bi turlu olmuyor. Istedigim sey su: A sutununda bazi rakamlar var bunlar 1-2-3-3-3-4-5 olsun. B sutunundada 1-2-3-4-5-7 olsun. Bu ikisini karsilastirdigimda misal 3 A sutununda 3 tane iken B sutununda 1 tane. Bunu tespit edip geri kalan 2 tane 3 e yok yazmasini istiyorum. Forumdaki formulleri uygulamak istedigimde ya esitleme yapmislar yada karsilastirip yapmislar fakat hata suki esitleme yapilamiyor cunki ayni sayidan binlerce var bunlari buyukten kucuge dizsem bile B sutunumda daha az sayi oldugu icin karsina denk gelmiyor. Karsilastirma yapilamiyor cunki atiyorum 3 sayisini 3 tame oldugunu farkedemeyip hepsine var diyor halbuki 2 tane si yok... Benim istedigim bu iki sutunu karsilastirip eslesturip ayni olan sayilari silip yada boyayip olmayan sayilari her iki sutun icinde gecerli olacak sekilde yazmasi...Umarim anlatanilmisimdir... Yardiminiz icin tesekkur ederim

örnek linki: http://www.mediafire.com/view/3a3t2jg3w29csxp/örnek.xlsx
 
Son düzenleme:
. . .

Örnek dosya yüklerseniz üzerinde çalışalım.

. . .
 
Kod: 
Sub ikiSutunKarsilastir()
'veyselemre
    [a:c].Interior.ColorIndex = xlNone
    [e2:j65536].ClearContents
    sat = 2
    For i = 3 To [a65536].End(3).Row
        bulundu = False
        For ii = 3 To [c65536].End(3).Row
            If Cells(ii, 3).Interior.ColorIndex <> 4 Then
                If Abs(Cells(i, 1) - Cells(ii, 3)) < 0.01 Then
                    'If Cells(i, 1) = Cells(ii, 3) Then
                    sat = sat + 1
                    Cells(i, 1).Copy Cells(sat, 9)
                    Cells(ii, 3).Copy Cells(sat, 10)

                    Cells(i, 1).Interior.ColorIndex = 4
                    Cells(ii, 3).Interior.ColorIndex = 4
                    bulundu = True

                    Exit For
                End If
            End If
        Next ii
        If bulundu = False Then [g65536].End(3).Offset(1) = Cells(i, 1)
    Next i
    For i = 3 To [c65536].End(3).Row
        If Cells(i, 3).Interior.ColorIndex <> 4 Then
            [e65536].End(3).Offset(1) = Cells(i, 3)
        End If
    Next i
End Sub
 
Son düzenleme:
konuyu okuyacaklar için son toplama yapalım.
eğer iki sutun karsılastırıp olup olmayanları bulup bunları baska hucrelerde otomatik yazılmasını istiyorsanır sayın @veyselemre kardeşimizin verdiği kodu kullanın. eğer sutunlar arasında boyama yoluyla ve yukarıdan renklılerı kapatarak sonucu elde etmek ıstıyorsanız sayın@hüseyinçoban kardeşimizin verdiği ekteki dosyayı indirin.

Veyselemre ve Hüseyin Çobana gösterdikleri ilgiden dolayı teşekkür ederim...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst