[Yardım]  VBA Üzerinden Dosyalar Arası Karşılaştırmalı Veri Çekme

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

VBA Üzerinden Dosyalar Arası Karşılaştırmalı Veri Çekme

İleti#1)  dfx2med » 10 Ekm 2019 11:01

Herkese Merhaba;
Bir problemle karşılaştım ve VBA'yı daha öncesinden bilmiyordum.2 gün kadar üzerinde uğraştım fakat daha ileriye gidemedim.
Problem şu ki;
satır no:1423 I 40.hafta I 07.10.2019 I xc24-kjh25 I dondurma I erimiş I 5 I 80 I (80 taneden 5 tanesi )
satır no:1424 I 40.hafta I 07.10.2019 I xc24-sad53 I makas I kırık I 11 I 110 I (110 taneden 11 tanesi )
satır no:1425 I 40.hafta I 07.10.2019 I xda9-kjk42 I nükleer başlık I erimiş I 1 I 14 I (14 taneden 1 tanesi )
.
.
.
41.hafta......

tarzında verilerim bulunmaktadır.Bu veriler Dosya_Yolu1: c:/excel/...d1.xlsx üzerinde belirtilen satırda bulunmaktadır.
Benim istediğim ise Dosya_Yolu2: c:/desktop/....d2.xlsx dosyasın da hata türüne göre hata sayısını girmesi.

Hata çeşitleri Dosya_Yolu2 dosyasın da d5-e5-f5-g5-h5 sutunlarında yazılı ve Dosya_Yolu1 deki satır sayısına göre sırasıyla doldurmasını istiyorum.

Çok mu zor bunu yapabilmem. Şimdiden teşekkür ediyorum.


Kod: Tümünü seç
Sub DUSEYARA()
Dim isim As String
Dim hurda_miktari As String
Dim arabsmk As String

hurda_miktari = Application.WorksheetFunction.VLookup("40.Hafta", Sayfa1.Range("C:Z"), 7, True)
arabsmk = Application.WorksheetFunction.VLookup("40.Hafta", Sayfa1.Range("C:Z"), 6, True)

If arabsmk = "erimiş" Then

Worksheets(2).[A2].Value = hurda_miktari
Worksheets(2).[B2].Value = " "
Worksheets(2).[C2].Value = " "
Worksheets(2).[D2].Value = " "
Worksheets(2).[E2].Value = " "
Worksheets(2).[F2].Value = " "
Worksheets(2).[G2].Value = " "
Worksheets(2).[H2].Value = " "

MsgBox "Hurda Ürün Miktarı : " & hurda_miktari & "  " & arabsmk

ElseIf arabsmk = "kırık" Then

Worksheets(2).[A2].Value = " "
Worksheets(2).[B2].Value = hurda_miktari
Worksheets(2).[C2].Value = " "
Worksheets(2).[D2].Value = " "
Worksheets(2).[E2].Value = " "
Worksheets(2).[F2].Value = " "
Worksheets(2).[G2].Value = " "
Worksheets(2).[H2].Value = " "

MsgBox "Hurda Ürün Miktarı : " & hurda_miktari & "  " & arabsmk

ElseIf arabsmk = "bozuk" Then

Worksheets(2).[A2].Value = " "
Worksheets(2).[B2].Value = " "
Worksheets(2).[C2].Value = hurda_miktari
Worksheets(2).[D2].Value = " "
Worksheets(2).[E2].Value = " "
Worksheets(2).[F2].Value = " "
Worksheets(2).[G2].Value = " "
Worksheets(2).[H2].Value = " "

MsgBox "Hurda Ürün Miktarı : " & hurda_miktari & "  " & arabsmk

ElseIf arabsmk = "YIRTIK" Then

Worksheets(2).[A2].Value = " "
Worksheets(2).[B2].Value = " "
Worksheets(2).[C2].Value = " "
Worksheets(2).[D2].Value = hurda_miktari
Worksheets(2).[E2].Value = " "
Worksheets(2).[F2].Value = " "
Worksheets(2).[G2].Value = " "
Worksheets(2).[H2].Value = " "

MsgBox "Hurda Ürün Miktarı : " & hurda_miktari & "  " & arabsmk

ElseIf arabsmk = "denenmiş" Then

Worksheets(2).[A2].Value = " "
Worksheets(2).[B2].Value = " "
Worksheets(2).[C2].Value = " "
Worksheets(2).[D2].Value = " "
Worksheets(2).[E2].Value = hurda_miktari
Worksheets(2).[F2].Value = " "
Worksheets(2).[G2].Value = " "
Worksheets(2).[H2].Value = " "

MsgBox "Hurda Ürün Miktarı : " & hurda_miktari & "  " & arabsmk


Else

MsgBox " HURDA NEDENİ BELİRLENEMEDİ! "

End If



End Sub
Kullanıcı avatarı
dfx2med
 
Kayıt: 10 Ekm 2019 10:18
Meslek: öğrenci
Yaş: 23
İleti: 1
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: kayseri

Cevap: VBA Üzerinden Dosyalar Arası Karşılaştırmalı Veri Çek

İleti#2)  Ali ÖZ » 11 Ekm 2019 16:14

Merhaba,
Örnek dosya ekleyebilir misiniz.
Allah bize yeter, O ne güzel vekildir.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Kullanıcı avatarı
Ali ÖZ
Forum Moderatörü
 
Adı Soyadı:Ali ÖZ
Kayıt: 17 Oca 2013 10:16
Konum: SAKARYA
Meslek: Yazılım
Yaş: 38
İleti: 9864
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adapazarı/SAKARYA


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot ve 1 misafir

Bumerang - Yazarkafe