2 farklı çalışma kitabından veri eşleştirme ve fiyat güncelleme

[Leronoy]

Merhaba,

2 farklı çalışma kitabında aynı barkodla ürünler var ama farklı satırlarda ve sütunlarda yer almaktalar. "a" kitabındaki ürün barkodu "b" de bulup aynı satırdaki fiyat bilgisini "a" daki fiyatın üzerine yazmasını istiyorum. Amacım fiyatları güncellemek. DÜŞEYARA fonksiyonunu denedim ama beceremedim . Yardımcı olursanız memnun olurum. Teşekkürler...

Dosya linki

 

[Baggwell]

Merhabalar, öncelikle sorunuzu anlatan bir örnek dosya paylaşın yardımcı olalım

 

[Leronoy]

Dosyayı ilk mesajıma ekledim. Teşekkürler...

 

[PLİNT]

Merhaba
Ek dosyayı inceleyin.
http://www.upturkey.com/download.php?file=402kitap.zip

[SIZE="2"]Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Workbooks.Open Filename:=ThisWorkbook.Path & "\B" & ".xlsx"
ActiveWorkbook.Sheets(1).Select
For A = 1 To Workbooks("A.xlsm").Sheets(1).Cells(Rows.Count, 8).End(xlUp).Row
With ActiveWorkbook.Sheets(1).Range("d1:d" & ActiveWorkbook.Sheets(1).Cells(Rows.Count, 4).End(xlUp).Row)
    Set c = .Find(Workbooks("A.xlsm").Sheets(1).Cells(A, 8).Value, LookAt:=xlWhole)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
     Workbooks("A.xlsm").Worksheets(1).Cells(A, 12) = ActiveWorkbook.Sheets(1).Cells(c.Row, 11)
            Set c = .FindNext(c)
If c Is Nothing Then Exit Do
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
Next
Workbooks("B.xlsx").Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub [/SIZE]

 

[Leronoy]

Hocam çok teşekkür ederim. Ellerine sağlık...
Fiyatın haricinde adet kontrolünü de sağlatmamız mümkün mü?

 

[PLİNT]

Hocam çok teşekkür ederim. Ellerine sağlık...
Fiyatın haricinde adet kontrolünü de sağlatmamız mümkün mü?

Sağolun, merhaba.
"Adet" lerin geleceği sütun (A) dosyasında tam olarak belli değil "G" sütunu
olacak ise;
Kodlardaki ilgili kısma aşağıdaki kırmızı bölümü ekleyin.

[SIZE="2"]'......
'.........
        firstAddress = c.Address
        Do
     Workbooks("A.xlsm").Worksheets(1).Cells(A, 12) = ActiveWorkbook.Sheets(1).Cells(c.Row, 11)
[COLOR="Red"] Workbooks("A.xlsm").Worksheets(1).Cells(A, "G") = ActiveWorkbook.Sheets(1).Cells(c.Row, "H")[/COLOR]
            Set c = .FindNext(c)
If c Is Nothing Then Exit Do
'......
'.........
End sub[/SIZE]