• DİKKAT

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

Farklı bir çalışma sayfasında veri çekme sorunu

Soundcraft

Soundcraft

Altın Üye
Katılım
29 Aralık 2005
Mesajlar
33
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Değerli arkadaşlar,

2 adet excel dosyamız mevcut Urun.xls ve Export.xls

Urun.xls dosyasında A sütunundaki veriyi Export.xls dosyasında C sütununda arayarak bulduğumuz verinin aynı satırında G sütunundaki veriyi Urun.xls dosyasında aradığımız verinin satırındaki AQ sutun hücresine eklemek istiyorum.

Kısacası Urün dosyasındaki ID değeri Export Dosyasındaki WID değeriyle eşleşen stok değerini Ürün dosyasına yazdırmak istiyorum.

Düşeyara ile yapmaya çalıştım ancak nerede hata yaptığımı anlayamadım ve sonuca ulaşamadım.

Bu konuda beni yönlendirebilir ve yardımcı olabilirseniz çok sevinirim.

ilgili 2 dosyayı da ekliyorum.
 

Ekli dosyalar

. . .

2 excel tablosunu aynı klasör içine alın ve
Ürün tablosuna aşağıdaki kodları ekleyerek çalıştırın.

Kod: 
Sub KOD()
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    yol = ThisWorkbook.Path & "\"
    Dim K1 As Workbook: Dim S1 As Worksheet
    Dim K2 As Workbook: Dim S2 As Worksheet
    Set K1 = Workbooks("Urun.xls"): Set S1 = K1.Sheets("Worksheet")
    S1.Range("AQ:AQ").ClearContents
    S1.Range("AQ1") = "Stok"

    Workbooks.Open (yol & "Export.xls")
    Application.ActiveProtectedViewWindow.Edit
    Set K2 = Workbooks("Export.xls"): Set S2 = K2.Sheets("Temp1")
    
    For i = 2 To S1.Cells(Rows.Count, "A").End(3).Row
        If WorksheetFunction.CountIf(S2.Range("C:C"), S1.Cells(i, "A")) > 0 Then
            S1.Cells(i, "AQ") = _
            WorksheetFunction.VLookup(S1.Cells(i, "A"), S2.Range("C:G"), 5, 0)
        Else
            S1.Cells(i, "AQ") = 0
        End If
    Next i
    
    K2.Close , False
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "B i t t i "
End Sub

. . .
 
İlgi ve alakanız için teşekkür ederim.

Kod çalıştı. Yanlız bir ihtiyaç daha hasıl oldu.
Aynı seçimle (G sütunundaki veriyi AQ Sütununa ekleme gibi) I sütunundaki veriyi W sütunundaki eşdeğer hücreye
J sütunundaki veriyi de X sütunundaki eşdeğer hücreye eklemek için vede Mantığını da kavramak adına vb kodunda hangi değişikliği yapmalıyız.

Yani stok miktarını aldığımız gibi I sütunu Fiyat1 ve J sütunu Fiyat2 hanelerini de aynı şekilde alabilirmiyiz?
 
Aynı kodun devamında mı alacak yoksa
2 kodu ayrı ayrı mı çalıştıracaksınız.

.
 
Aynı kod ile çalıştıracağız. Yani tek komut ile hem Stok miktarını hemde Fiyat1 ve Fiyat2 yi çağıracağız
 
. . .

Export tablosunda fiyatla ilgili sütunlar yok.

. . .
 
Evet haklısınız.

Fiyatları çekmek sonradan hasıl olduğu için yeniden düzenlendi.

Güncel dosyayı ekledim şimdi.
 

Ekli dosyalar

Soundcraft' Alıntı:
Evet haklısınız.

Fiyatları çekmek sonradan hasıl olduğu için yeniden düzenlendi.

Güncel dosyayı ekledim şimdi.
Genişletmek için tıkla ...
. . .

Kod: 
Sub KOD()
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    yol = ThisWorkbook.Path & "\"
    Dim K1 As Workbook: Dim S1 As Worksheet
    Dim K2 As Workbook: Dim S2 As Worksheet
    Set K1 = Workbooks("Urun.xls"): Set S1 = K1.Sheets("Worksheet")
    S1.Range("AQ:AQ").ClearContents: S1.Range("AQ1") = "Stok"
[COLOR="Blue"]    S1.Range("W:W").ClearContents: S1.Range("W1") = "Fiyat"
    S1.Range("X:X").ClearContents: S1.Range("X1") = "Fiyat1"[/COLOR]
    
    Workbooks.Open (yol & "Export.xls")
    Application.ActiveProtectedViewWindow.Edit
    Set K2 = Workbooks("Export.xls"): Set S2 = K2.Sheets("Temp1")
    
    For i = 2 To S1.Cells(Rows.Count, "A").End(3).Row
        If WorksheetFunction.CountIf(S2.Range("C:C"), S1.Cells(i, "A")) > 0 Then
            S1.Cells(i, "AQ") = _
            WorksheetFunction.VLookup(S1.Cells(i, "A"), S2.Range("[COLOR="Blue"]C:I[/COLOR]"), 5, 0)
            
    [COLOR="Blue"]        S1.Cells(i, "W") = _
            WorksheetFunction.VLookup(S1.Cells(i, "A"), S2.Range("C:I"), 6, 0)
            
            S1.Cells(i, "X") = _
            WorksheetFunction.VLookup(S1.Cells(i, "A"), S2.Range("C:I"), 7, 0)
            [/COLOR]
        Else
            S1.Cells(i, "AQ") = 0
     [COLOR="Blue"]       S1.Cells(i, "W") = 0
            S1.Cells(i, "X") = 0[/COLOR]
            
        End If
    Next i
    
    K2.Close , False
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "B i t t i "
End Sub

. . .
 
veri çekme

Hüseyin Çoban' Alıntı:
. . .

Kod: 
Sub KOD()
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    yol = ThisWorkbook.Path & "\"
    Dim K1 As Workbook: Dim S1 As Worksheet
    Dim K2 As Workbook: Dim S2 As Worksheet
    Set K1 = Workbooks("Urun.xls"): Set S1 = K1.Sheets("Worksheet")
    S1.Range("AQ:AQ").ClearContents: S1.Range("AQ1") = "Stok"
[COLOR="Blue"]    S1.Range("W:W").ClearContents: S1.Range("W1") = "Fiyat"
    S1.Range("X:X").ClearContents: S1.Range("X1") = "Fiyat1"[/COLOR]
    
    Workbooks.Open (yol & "Export.xls")
    Application.ActiveProtectedViewWindow.Edit
    Set K2 = Workbooks("Export.xls"): Set S2 = K2.Sheets("Temp1")
    
    For i = 2 To S1.Cells(Rows.Count, "A").End(3).Row
        If WorksheetFunction.CountIf(S2.Range("C:C"), S1.Cells(i, "A")) > 0 Then
            S1.Cells(i, "AQ") = _
            WorksheetFunction.VLookup(S1.Cells(i, "A"), S2.Range("[COLOR="Blue"]C:I[/COLOR]"), 5, 0)
            
    [COLOR="Blue"]        S1.Cells(i, "W") = _
            WorksheetFunction.VLookup(S1.Cells(i, "A"), S2.Range("C:I"), 6, 0)
            
            S1.Cells(i, "X") = _
            WorksheetFunction.VLookup(S1.Cells(i, "A"), S2.Range("C:I"), 7, 0)
            [/COLOR]
        Else
            S1.Cells(i, "AQ") = 0
     [COLOR="Blue"]       S1.Cells(i, "W") = 0
            S1.Cells(i, "X") = 0[/COLOR]
            
        End If
    Next i
    
    K2.Close , False
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "B i t t i "
End Sub

. . .
Genişletmek için tıkla ...

Hüseyin Bey iyi akşamlar,

Veri çekme ile ilgili bir sorunum var. yapılabilme ihtimali varmıdır bilmiyorum. varsa benim için aylarca sürecek bir işlemi çözmüş olursunuz :-)

şöyleki,

1- bir klasör içinde birçok klasör ve bu klasörlerin içerisinde yüzlerce excel var.
2- bu excel dosyalarının isimleri ve sayfa isimleri farklı. sadece her excelin içinde 1 sayfa var.
3- rapor olarak bir excelin içerisine bu klasörlerdeki excellerden benim belirlediğim değerlere göre (örn. analiz1 değeri, analiz2 değeri gibi) otomatik hepsini getirmek mümkün olurmu?
4- yani hem klasör içindeki tüm excellerden veri getirecek ve rapor excelinde getirdiği veriyi ilgili karşılığını bulup oraya yazacak.

birçok talep sözkonusu ama yapılabilme ihtimali varsa benim için dediğim gibi aylarac sürecek bir işlem. yardımlarınız için şimdiden çok teşekkürler
 
. . .

Yeni konu açarak tablonuzun örneklerini yükleyin inceleyelim.

. . .
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst