Veri sayısına göre düşey ara hk.

[hakanaslan78]

Merhaba Arkadaşlar,

Aşağıdaki kodu sürekli değiken veri sayısına göre nasıl bir şekilde döngüye uyarlarım.

Sub düşeyara()

Dim s2 As Worksheet
Dim s1 As Worksheet

Set s1 = Sheets("STOK ENVANTERİ")
Set s2 = Sheets("ÜRÜN SATIŞLARI")

s2.Range("J3") = WorksheetFunction.VLookup(s2.Range("A3"), s1.Range("A:C"), 3, 0)

End Sub

Saygılarımla,

Hakan ASLAN

 

[Muzaffer Ali]

Merhaba Hakan.
Biraz açıklar mısın? Soru pek anlaşılmıyor.

 

[hamitcan]

Aranan veri bulunamadığında Düşeyara fonksiyonu hata verir. Bence aşağıdaki şekilde kullanmanız daha sağlıklı olacak.

Sub düşeyara()

    Dim s2 As Worksheet
    Dim s1 As Worksheet
    
    Set s1 = Sheets("STOK ENVANTERİ")
    Set s2 = Sheets("ÜRÜN SATIŞLARI")
    For i = 2 To s2.[a65536].End(3).Row
        Set a = s1.Columns("a:c").Find(s2.Cells(i, 3))
        If Not a Is Nothing Then
            s2.Cells(i, 3) = s1.Cells(a.Row, 3)
        End If
    Next
    's2.Range("J3") = WorksheetFunction.VLookup(s2.Range("A3"), s1.Range("A:C"), 3, 0)

End Sub

 

[hakanaslan78]

Aranan veri bulunamadığında Düşeyara fonksiyonu hata verir. Bence aşağıdaki şekilde kullanmanız daha sağlıklı olacak.

Sub düşeyara()

    Dim s2 As Worksheet
    Dim s1 As Worksheet
   
    Set s1 = Sheets("STOK ENVANTERİ")
    Set s2 = Sheets("ÜRÜN SATIŞLARI")
    For i = 2 To s2.[a65536].End(3).Row
        Set a = s1.Columns("a:c").Find(s2.Cells(i, 3))
        If Not a Is Nothing Then
            s2.Cells(i, 3) = s1.Cells(a.Row, 3)
        End If
    Next
    's2.Range("J3") = WorksheetFunction.VLookup(s2.Range("A3"), s1.Range("A:C"), 3, 0)

End Sub

Hamitcan Bey merhaba,

Öncelikle çok teşekkür ederim. Sanırım bir yerde anlatım eksikliğinde bulundum. Çalışma dosyasını ekliyorum, incelerseniz çok memnun olurum.

Saygılarımla,

Hakan ASLAN

 

[hakanaslan78]

Merhaba Hakan.
Biraz açıklar mısın? Soru pek anlaşılmıyor.

Muzaffer Bey Merhaba,

Kusura bakmayın sizin cevabınızı atlamışım. İlginiz için teşekkürler.

Saygılarımla,

Hakan ASLAN

 

[hamitcan]

Dosyanız açılmıyor. Dosyanızın sıkıştırılmamış ufak bir örneğini ekleyin.

 

[hakanaslan78]

Dosyanız açılmıyor. Dosyanızın sıkıştırılmamış ufak bir örneğini ekleyin.

Hamitcan Bey günaydın,

Verileri ne kadar silsemde sıkıştırmadan ekleyemedim. Dosya 2,40 mb altına düşmedi. Bundan dolayı size google drive linki yolluyorum.

SATIŞ FATURALARI MAKRO ÇALIŞMASI.xlsm

drive.google.com

Saygılarımla,

 

[hamitcan]

Bu şekilde dener misiniz ?

Sub düşeyara()

Dim s2 As Worksheet
Dim s1 As Worksheet

Set s1 = Sheets("STOK ENVANTERİ")
Set s2 = Sheets("ÜRÜN SATIŞLARI")

For i = 2 To s2.[a65536].End(3).Row
        Set a = s1.Columns("a:c").Find(s2.Cells(i, 1))
        If Not a Is Nothing Then
            s2.Cells(i, "j") = s1.Cells(a.Row, 3)
        End If
    Next


's2.Range("J3") = WorksheetFunction.VLookup(s2.Range("A3"), s1.Range("A:C"), 3, 0)

End Sub

 

[hakanaslan78]

Bu şekilde dener misiniz ?

Sub düşeyara()

Dim s2 As Worksheet
Dim s1 As Worksheet

Set s1 = Sheets("STOK ENVANTERİ")
Set s2 = Sheets("ÜRÜN SATIŞLARI")

For i = 2 To s2.[a65536].End(3).Row
        Set a = s1.Columns("a:c").Find(s2.Cells(i, 1))
        If Not a Is Nothing Then
            s2.Cells(i, "j") = s1.Cells(a.Row, 3)
        End If
    Next


's2.Range("J3") = WorksheetFunction.VLookup(s2.Range("A3"), s1.Range("A:C"), 3, 0)

End Sub

Bilmiyorum sizde nasıl çalışıyor ama bende 5 dk oldu henüz 9000 veriye ulaşabildi ve bilgisayara aşırı yük bindi. Farklı bir kodlama ile daha hızlı olmasını sağlaya bilirmiyiz sizce.

 

[hamitcan]

Döngüsüz olabileceğini düşünmüyorum ama farklı bir çözüm için tekrar destek isteyebilirsiniz tabii ki.

 

[Muzaffer Ali]

Aşağıdaki kodu deneyin.

Sub test()
    Dim Satirsay As Integer
    Satirsay = Sheets("ÜRÜN SATIŞLARI").Cells(Rows.Count, "A").End(xlUp).Row
    With Sheets("ÜRÜN SATIŞLARI").Range("J3:J" & Satirsay)
        .Formula = "=VLookup(A3, 'STOK ENVANTERİ'!A:C, 3, 0)"
        .Copy
        .PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End With
End Sub

 

[hakanaslan78]

Aşağıdaki kodu deneyin.

Sub test()
    Dim Satirsay As Integer
    Satirsay = Sheets("ÜRÜN SATIŞLARI").Cells(Rows.Count, "J").End(xlUp).Row
    With Sheets("ÜRÜN SATIŞLARI").Range("J3:J" & Satirsay)
        .Formula = "=VLookup(A3, 'STOK ENVANTERİ'!A:C, 3, 0)"
        .Copy
        .PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End With
End Sub

Merhaba Muzaffer Bey,

Sadece iki değer getirdi ve yanlış satırdan başlayarak.

 

[Muzaffer Ali]

Kodu düzelttim yeniden deneyin.

 

[hakanaslan78]

Kodu düzelttim yeniden deneyin.

Çok hızlı ve doğru çalıştı, ellerinize sağlık. Sadece küçük bir detay kaldı, karşılığını bulamadığı değerlerin #Yok yerine - çizgi işaretini yazdıra bilirmiyiz.

 

[Muzaffer Ali]

Sub test()
    Dim Satirsay As Integer
    Satirsay = Sheets("ÜRÜN SATIŞLARI").Cells(Rows.Count, "A").End(xlUp).Row
    With Sheets("ÜRÜN SATIŞLARI").Range("J3:J" & Satirsay)
        .Formula = "=VLookup(A3, 'STOK ENVANTERİ'!A:C, 3, 0)"
        .Copy
        .PasteSpecial xlPasteValues
        .Replace "#N/A", Replacement:="-"
        Application.CutCopyMode = False
    End With
End Sub