Excel Forum


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama



Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 31-01-2013, 12:21   #1
kan-nas
 
Giriş: 09/07/2008
Şehir: İST
Mesaj: 271
Excel Vers. ve Dili:
2007
Varsayılan Ad ve Tarih eşleştirme..

Merhaba,

A ve B kolundaki isim ve tarih ile D koloundaki isim ve tarih olanları J ve k kolonuna yazdırabilir miyiz?

Excelde açıklaması var. İyi çalışmalar.
Eklenmiş Dosyalar
Dosya Türü: xlsx vade ve isim.xlsx (10.0 KB, 21 Görüntülenme)
__________________
Fatır Süresi 5.ayet: ‘‘ Sakın dünya hayatı sizi aldatmasın. Sizi aldatan Allah ile aldatmasın.’’
kan-nas Çevrimdışı   Alıntı Yaparak Cevapla
Eski 31-01-2013, 12:41   #2
Civan Jack
 
Civan Jack kullanıcısının avatarı
 
Giriş: 29/08/2009
Şehir: İstanbul
Mesaj: 401
Excel Vers. ve Dili:
2007 Türkçe
Varsayılan

Bir döngü kurup a-b ile d-e sütunlarındakiler birbirine eşitse şartıyla kopyalama yapacaksınız. Bunu siz de yapabilirsiniz Sn. kan-nas.
Civan Jack Çevrimdışı   Alıntı Yaparak Cevapla
Eski 31-01-2013, 13:45   #3
kan-nas
 
Giriş: 09/07/2008
Şehir: İST
Mesaj: 271
Excel Vers. ve Dili:
2007
Varsayılan

Üstad, döngü kurdum ama yapamadım. a1 kolonunda Ali ye bak d1 de varsa yaz ya da b1 kolonnunda 01-01-2013 e bak.E kolunda varsa yaz değil.Bunu ben de yaptım.
A1 kolonunda Ali B1 kolonunda 01-01-2013 varsa bunu D ve E kolounundaki aynı sıradaki Ali ve 01-01-2013 le karşılaştır varsa yaz. Örnekte A ve Bkolonundaki 2. satırdaki ali 01-01-2013 ü D ve E kolonunda 3 sırada bulunan ali ve 01-01-2013 ile eşleştirsin.
Valla yapabilseydim buraya yazmazdım.S. Civan Jack
__________________
Fatır Süresi 5.ayet: ‘‘ Sakın dünya hayatı sizi aldatmasın. Sizi aldatan Allah ile aldatmasın.’’
kan-nas Çevrimdışı   Alıntı Yaparak Cevapla
Eski 31-01-2013, 13:57   #4
Necdet Yeşertener
Moderatör
 
Giriş: 04/06/2005
Şehir: Ankara
Mesaj: 10,839
Excel Vers. ve Dili:
Ofis 2003 İngilizce Ofis 2007 Türkçe Ofis 2010 Türkçe
Varsayılan

Merhaba,

Aşağıdaki kodları dener misiniz?

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 
Sub Karsilastir()
    
    Dim i   As Long, _
        j   As Integer, _
        c   As Range, _
        adr As String
    
    Application.ScreenUpdating = False
    
    Range("J2:K" & Rows.Count).Clear
    j = 1
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        With Range("D:D")
            Set c = .Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                adr = c.Address
                Do
                    If Cells(i, "B") = Cells(c.Row, "E") Then
                        j = j + 1
                        Cells(j, "J") = Cells(i, "A")
                        Cells(j, "K") = Cells(i, "B")
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> adr
            End If
        End With

    Next i
    
    If j = 1 Then
        MsgBox "HİÇ KARŞILAŞTIRMA OLMADI....", vbCritical, "excel.web"
    Else
        MsgBox j - 1 & " ADET BENZER KAYIT BULUNDU....", vbInformation, "excel.web"
    End If
    
    Application.ScreenUpdating = True
    
End Sub
__________________
Sayfada Boş Satırları Silmek:
Sütunu Seçiniz, F5, Özel, Boşluklar, Tamam,
Sağ Klik, Sil, Tüm Satır, Tamam

Türkçe'nin Bir Eksiği Yok, Ya Sizin?



Necdet Yeşertener Çevrimdışı   Alıntı Yaparak Cevapla
Eski 31-01-2013, 14:46   #5
Murat OSMA
Eğitmen
 
Murat OSMA kullanıcısının avatarı
 
Giriş: 23/05/2011
Şehir: İstanbul
Mesaj: 3,727
Excel Vers. ve Dili:
Excel 2013 - Türkçe Excel 2010 - Türkçe
Varsayılan

Alternatif;

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Karsilastir()
    Dim i As Integer, a As Integer
    Dim Rky As Range
    a = 2: Range("J2:K" & Rows.Count).Clear
    For Each Rky In Range("A2:A" & Range("A65536").End(3).Row)
        For i = 2 To Range("D65536").End(3).Row
            If Rky.Value = Cells(i, 4) And _
               Rky.Offset(0, 1).Value = Cells(i, 5) Then
               Rky.Resize(, 2).Copy Cells(a, "J")
               a = a + 1
            End If
        Next i
    Next Rky
    i = Empty: a = Empty
    Set Rky = Nothing
End Sub
__________________
https://www.youtube.com/watch?v=kvTDdU7U1_A
Murat OSMA Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 05:38


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.


Bahis Forum - Define - Çorlu Kamera - Çorlu Petek Temizleme - Site Yönetimi - TYPO3 Türkiye - 2015 Fuar - Çorlu Mimarlık - Çorlu Hotel - Rotary Web Sitesi
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden