• DİKKAT

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

Değer karşılaştırıp sayfalar arası veri transferi

Katılım
15 Aralık 2008
Mesajlar
202
Excel Vers. ve Dili
excel 2010
Merhaba;
Konu Eski Konu linkinde açıldı ancak dosyanın karmaşık olması nedeniyle çözüm bulunamadı, Linkteki konu çöpe taşınabilir.
Sadeleştirilmiş dosya ve açıklamaları ekledim.
Yardımcı olacak arkadaşlara şimdiden teşekkürler.
Örnek Dosya
 
Merhaba,

Verilerinizi yedekleyip aşağıdaki kodu deneyiniz.

C++:
Option Explicit

Sub Lot_Miktarlarini_Guncelle()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Aranan As String
    Dim Son As Long, Veri As Variant, X As Long, Say As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("SKP")
    Set S2 = Sheets("GCKS")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = S1.Range("A2:G" & Son).Value
    
    ReDim Liste(1 To Son, 1 To 1)
    
    For X = LBound(Veri) To UBound(Veri)
        Aranan = Veri(X, 1) & "|" & Veri(X, 2) & "|" & Veri(X, 6)
        If Not Dizi.Exists(Aranan) Then
            Say = Say + 1
            Dizi.Add Aranan, Say
            Liste(Say, 1) = Veri(X, 7)
        End If
    Next
    
    Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = S2.Range("A2:D" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        Aranan = Veri(X, 1) & "|" & Veri(X, 2) & "|" & Veri(X, 3)
        If Dizi.Exists(Aranan) Then
            Liste(Dizi.Item(Aranan), 1) = Veri(X, 4)
        End If
    Next
    
    If Dizi.Count > 0 Then S1.Range("G2").Resize(Dizi.Count) = Liste
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
    
    MsgBox "LOT miktarları güncellenmiştir." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Üstadım eline emeğine bilgine sağlık. Çok teşekkür ederim.
 
Geri
Üst