• DİKKAT

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

TC No Karşılaştırma ve Eşit Olanlara Veri Aktarımı

M

mustappa68

Katılım
14 Nisan 2020
Mesajlar
8
Excel Vers. ve Dili
Office 2010
Merhaba arkadaşlar,
İşyerimizde kullanmakta olduğumuz programdan alınan verileri excele aktararak banka kartlarına nakit yükleme işlemi yapıyoruz.
Excel listesinde bulunan yaklaşık 8000 kayıt (Sayfa-1) sabit kalıyor, nakit yüklenecekler listesi (sayfa-2)haftalık değişiyor.
Her iki sayfada da ortak veri TC Kimlik numarası.
*benim istediğim Sayfa-1 ve Sayfa-2 deki TC Kimlik numaralı karşılaştırılacak,
TC no eşit olanların Sayfa-2 deki E sütunundaki para miktarı, Sayfa-1 'deki G sütununa yazılacak
Yardımcı olabilir misiniz? Teşekkür ederim .
 

Ekli dosyalar

mustappa68' Alıntı:
Merhaba arkadaşlar,
İşyerimizde kullanmakta olduğumuz programdan alınan verileri excele aktararak banka kartlarına nakit yükleme işlemi yapıyoruz.
Excel listesinde bulunan yaklaşık 8000 kayıt (Sayfa-1) sabit kalıyor, nakit yüklenecekler listesi (sayfa-2)haftalık değişiyor.
Her iki sayfada da ortak veri TC Kimlik numarası.
*benim istediğim Sayfa-1 ve Sayfa-2 deki TC Kimlik numaralı karşılaştırılacak,
TC no eşit olanların Sayfa-2 deki E sütunundaki para miktarı, Sayfa-1 'deki G sütununa yazılacak
Yardımcı olabilir misiniz? Teşekkür ederim .
Genişletmek için tıkla ...

Ekli dosyayı inceler misiniz,
Bu şekilde mi bir çözüm istiyordunuz?
 

Ekli dosyalar

Teşekkür ederim Tamer bey, istediğim bu, fakat bunu formülü aşağı sürükleyerek değilde butona bağlı makro şeklinde yapabilir miyiz
 
mustappa68' Alıntı:
Teşekkür ederim Tamer bey, istediğim bu, fakat bunu formülü aşağı sürükleyerek değilde butona bağlı makro şeklinde yapabilir miyiz
Genişletmek için tıkla ...

Dosyanız ekte;

faydalı olması dileğiyle.....
 

Ekli dosyalar

metin_0606' Alıntı:
Sayın tamer G sütununa çekeceğimiz değerler sayı değilde tarih olsaydı kodda ne gibi değişiklik yapmamız gerekirdi. mevcut hali ile denedim tarihi sayı formatında çekti
Genişletmek için tıkla ...


Koyu yazılı satırı ilave ediniz.

.........
.........
SonSat = sh1.Cells(sh1.Rows.Count, "A").End(3).Row

sh1.Range("G2:G1000").ClearContents

sh1.Range("G2:G" & SonSat).NumberFormat = "dd.mm.yyyy"
........
........
 
Ziynettin' Alıntı:
Koyu yazılı satırı ilave ediniz.

.........
.........
SonSat = sh1.Cells(sh1.Rows.Count, "A").End(3).Row

sh1.Range("G2:G1000").ClearContents

sh1.Range("G2:G" & SonSat).NumberFormat = "dd.mm.yyyy"
........
........
Genişletmek için tıkla ...
ziynettin hocam dediğiniz gibi yaptım sanırım olmadı tarih olmayanların karşılığına da değer değer getirdi
 

Ekli dosyalar

Bu kodu deneyiniz.

Kod: 
Sub test()
Dim s1 As Worksheet, s2 As Worksheet
Dim a(), b(), dz As Object, i As Long, tc As String

Set s1 = Sheets("SABİT LİSTE")
Set s2 = Sheets("DEĞİŞKEN LİSTE")
Set dz = CreateObject("scripting.dictionary")

a = s2.Range("A1:E" & s2.Cells(Rows.Count, 4).End(3).Row).Value
    For i = 2 To UBound(a)
        tc = CStr(a(i, 4))
        If a(i, 5) <> "" Then
            dz(tc) = CDate(a(i, 5))
        End If
    Next i

Erase a

a = s1.Range("D2:D" & s1.Cells(Rows.Count, 4).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        tc = CStr(a(i, 1))
        If dz.exists(tc) Then
            b(i, 1) = dz(tc)
        Else
            b(i, 1) = ""
        End If
    Next i

s1.[G2].Resize(UBound(a)) = b
MsgBox "İşlem bitti.", vbInformation
End Sub
 
Ziynettin' Alıntı:
Bu kodu deneyiniz.

Kod: 
Sub test()
Dim s1 As Worksheet, s2 As Worksheet
Dim a(), b(), dz As Object, i As Long, tc As String

Set s1 = Sheets("SABİT LİSTE")
Set s2 = Sheets("DEĞİŞKEN LİSTE")
Set dz = CreateObject("scripting.dictionary")

a = s2.Range("A1:E" & s2.Cells(Rows.Count, 4).End(3).Row).Value
    For i = 2 To UBound(a)
        tc = CStr(a(i, 4))
        If a(i, 5) <> "" Then
            dz(tc) = CDate(a(i, 5))
        End If
    Next i

Erase a

a = s1.Range("D2:D" & s1.Cells(Rows.Count, 4).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        tc = CStr(a(i, 1))
        If dz.exists(tc) Then
            b(i, 1) = dz(tc)
        Else
            b(i, 1) = ""
        End If
    Next i

s1.[G2].Resize(UBound(a)) = b
MsgBox "İşlem bitti.", vbInformation
End Sub
Genişletmek için tıkla ...
Ziynettin hocam verdiğiniz makroda hata aldım hatalı hali ile çalışmayı paylaşıyorum
 

Ekli dosyalar

Bende hata vermiyor.

Aldığınız hatayı paylaşırmısınız.
 
Ziynettin' Alıntı:
Bu kodu deneyiniz.

Kod: 
Sub test()
Dim s1 As Worksheet, s2 As Worksheet
Dim a(), b(), dz As Object, i As Long, tc As String

Set s1 = Sheets("SABİT LİSTE")
Set s2 = Sheets("DEĞİŞKEN LİSTE")
Set dz = CreateObject("scripting.dictionary")

a = s2.Range("A1:E" & s2.Cells(Rows.Count, 4).End(3).Row).Value
    For i = 2 To UBound(a)
        tc = CStr(a(i, 4))
        If a(i, 5) <> "" Then
            dz(tc) = CDate(a(i, 5))
        End If
    Next i

Erase a

a = s1.Range("D2:D" & s1.Cells(Rows.Count, 4).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        tc = CStr(a(i, 1))
        If dz.exists(tc) Then
            b(i, 1) = dz(tc)
        Else
            b(i, 1) = ""
        End If
    Next i

s1.[G2].Resize(UBound(a)) = b
MsgBox "İşlem bitti.", vbInformation
End Sub
Genişletmek için tıkla ...
merhaba,
Aynı belgeye birtane de TEMİZLE botunu koyabilir miyiz?
Değişken Listeden (sayfa-2) aktarılan, sayfa-1 deki G sütununu ve Sayfa-2 deki Tüm sütunları silecek şekilde.
Değişken Liste(sayfa-2) haftalık değiştiği için; işlem tamamlandıktan sonra TEMİZLE butonuna tıkladığımızda,
önce uyarı mesajı verecek, (UYARI:Aktarılan veriler ve değişken liste silinecek,onaylıyormusunuz!) şeklinde ardından veriler temizlenecek.
 
Tarih biçimi olmadığı için hata satırı oluyor.

If a(i, 5) <> "" Then satırı If a(i, 5) <> "" And IsDate(a(i, 5)) Then olarak düzenleyin.
 
Son düzenleme:
#15. mesajda satır yerini ben yanlış ifade etmişim. Gerekli düzeltme yapıldı.


Kod: 
Sub test()
Dim s1 As Worksheet, s2 As Worksheet
Dim a(), b(), dz As Object, i As Long, tc As String

Set s1 = Sheets("SABIT LISTE")
Set s2 = Sheets("DEGISKEN LISTE")
Set dz = CreateObject("scripting.dictionary")

a = s2.Range("A1:E" & s2.Cells(Rows.Count, 4).End(3).Row).Value
    For i = 2 To UBound(a)
        tc = CStr(a(i, 4))
        If a(i, 5) <> "" And IsDate(a(i, 5)) Then
            dz(tc) = CDate(a(i, 5))
        End If
    Next i

Erase a

a = s1.Range("D2:D" & s1.Cells(Rows.Count, 4).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        tc = CStr(a(i, 1))
        If dz.exists(tc) Then
            b(i, 1) = dz(tc)
        Else
            b(i, 1) = ""
        End If
    Next i

s1.[G2].Resize(UBound(a)) = b
MsgBox "Islem bitti.", vbInformation
End Sub
 
tamer42' Alıntı:
Dosyanız ekte;

faydalı olması dileğiyle.....
Genişletmek için tıkla ...
Tamer bey rica etsem bunu da yapabilir misiniz?

Aynı belgeye birtane de TEMİZLE botunu koyabilir miyiz?
Değişken Listeden (sayfa-2) aktarılan, sayfa-1 deki G sütununu ve Sayfa-2 deki Tüm sütunları silecek şekilde.
Değişken Liste(sayfa-2) haftalık değiştiği için; işlem tamamlandıktan sonra TEMİZLE butonuna tıkladığımızda,
önce uyarı mesajı verecek, (UYARI:Aktarılan veriler ve değişken liste silinecek, onaylıyor musunuz!) şeklinde ardından veriler temizlenecek.
 
mustappa68' Alıntı:
merhaba,
Aynı belgeye birtane de TEMİZLE botunu koyabilir miyiz?
Değişken Listeden (sayfa-2) aktarılan, sayfa-1 deki G sütununu ve Sayfa-2 deki Tüm sütunları silecek şekilde.
Değişken Liste(sayfa-2) haftalık değiştiği için; işlem tamamlandıktan sonra TEMİZLE butonuna tıkladığımızda,
önce uyarı mesajı verecek, (UYARI:Aktarılan veriler ve değişken liste silinecek,onaylıyormusunuz!) şeklinde ardından veriler temizlenecek.
Genişletmek için tıkla ...

Kod: 
Sub test()
Dim s1 As Worksheet, s2 As Worksheet
Dim a(), b(), dz As Object, i As Long, tc As String

Set s1 = Sheets("SABİT LİSTE")
Set s2 = Sheets("DEĞİŞKEN LİSTE")
Set dz = CreateObject("scripting.dictionary")

a = s2.Range("A1:E" & s2.Cells(Rows.Count, 4).End(3).Row).Value
    For i = 2 To UBound(a)
        tc = CStr(a(i, 4))
        If a(i, 5) <> "" Then
            dz(tc) = (a(i, 5))
        End If
    Next i

Erase a

a = s1.Range("D2:D" & s1.Cells(Rows.Count, 4).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        tc = CStr(a(i, 1))
        If dz.exists(tc) Then
            b(i, 1) = dz(tc)
        Else
            b(i, 1) = ""
        End If
    Next i

s1.[G2].Resize(UBound(a)) = b
MsgBox "İşlem bitti.", vbInformation

If MsgBox("Aktarılan veriler ve değişken" & vbLf & vbLf & " liste silinecek,onaylıyormusunuz!", _
            vbYesNo + vbCritical) = vbNo Then Exit Sub
s2.Range("A2:E" & s2.Cells(Rows.Count, 4).End(3).Row) = ""
End Sub
 
Ziynettin' Alıntı:
#15. mesajda satır yerini ben yanlış ifade etmişim. Gerekli düzeltme yapıldı.


Kod: 
Sub test()
Dim s1 As Worksheet, s2 As Worksheet
Dim a(), b(), dz As Object, i As Long, tc As String

Set s1 = Sheets("SABIT LISTE")
Set s2 = Sheets("DEGISKEN LISTE")
Set dz = CreateObject("scripting.dictionary")

a = s2.Range("A1:E" & s2.Cells(Rows.Count, 4).End(3).Row).Value
    For i = 2 To UBound(a)
        tc = CStr(a(i, 4))
        If a(i, 5) <> "" And IsDate(a(i, 5)) Then
            dz(tc) = CDate(a(i, 5))
        End If
    Next i

Erase a

a = s1.Range("D2:D" & s1.Cells(Rows.Count, 4).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        tc = CStr(a(i, 1))
        If dz.exists(tc) Then
            b(i, 1) = dz(tc)
        Else
            b(i, 1) = ""
        End If
    Next i

s1.[G2].Resize(UBound(a)) = b
MsgBox "Islem bitti.", vbInformation
End Sub
Genişletmek için tıkla ...
Merhaba,
burada tabloya sonuçlar boş geliyordu,
If ........... End If aralığı yerine doğrudan "dz(tc) = CDate(a(i, 5))" yazılınca sorun çözüldü.

Kod: 
        If a(i, 5) <> "" And IsDate(a(i, 5)) Then
            dz(tc) = CDate(a(i, 5))
        End If
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst