Kritere göre bilgileri getirtmek

[sakoz]

Üstadlarım Merhabalar,

Öncelikle herkese iyi ve huzurlu çalışmalar dilerim.
Bir konuda yardımınıza ihtiyacım var.

Şimdi ekteki dosya orjinal işlem yapacağımız dosya.
Yapmak istediğimiz ;
FIYATLAMA sayfasındaki PARCA KODU yazan kısma herhangi bir parça kodu yazdığımızda , SIRKULER sayfasından kodu bulup PARCA ADI , KDV HARIC FIYAT , KDV DAHIL FIYAT, GENEL INDIRIM ORANI bilgilerinin gelmesini istiyoruz.
Bunun için bir makroya ihtiyacımız var.
Yardımcı olursanız çok sevinirim.
Şimdiden teşekkürler...


http://www.dosya.tc/server9/xgtvt2/SABLON.xlsx.html

 

[dellerlim]

Merhaba.
100 bin satır verinin olması çalışmayı çok yavaşlatacaktır sanırım.

 

[dellerlim]

Bu kodlar isteğinizi yerine getirebilir umarım.

Sub dene()
Application.ScreenUpdating = False
Set sf = ThisWorkbook.Worksheets("FIYATLAMA")
Set ss = ThisWorkbook.Worksheets("SIRKULER")
For i = 2 To 100433
For k = 10 To sf.Range("b65536").End(xlUp).Row
If sf.Cells(k, 2) = ss.Cells(i, 1) Then
sf.Cells(k, 3) = ss.Cells(i, 3)
sf.Cells(k, 4) = ss.Cells(i, 4)
sf.Cells(k, 5) = ss.Cells(i, 6)
sf.Cells(k, 6) = ss.Cells(i, 7)
End If
Next k
Next i
Application.ScreenUpdating = True
End Sub

 

[Orion1]

Dosyanız linktedir.

DOSYAYI İNDİR

Private Sub Worksheet_Change(ByVal Target As Range)
Dim k As Range, sh As Worksheet
If Intersect(Target, Range("B10:B" & Cells(Rows.Count, "B").End(xlUp).Row)) Is Nothing Then Exit Sub
Range("C" & Target.Row & ":F" & Target.Row).ClearContents
'If Target.Value = "" Then Exit Sub
Set sh = Sheets("SIRKULER")
Set k = sh.Range("A2:A" & sh.Cells(Rows.Count, "A").End(xlUp).Row) _
        .Find(Target.Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    Target.Offset(0, 1).Value = k.Offset(0, 2).Value
    Target.Offset(0, 2).Value = k.Offset(0, 3).Value
    Target.Offset(0, 3).Value = k.Offset(0, 5).Value
    Target.Offset(0, 4).Value = k.Offset(0, 6).Value
End If
End Sub

 

[sakoz]

Arkadaşlar çok çok teşekkür ederim..Ellerinize sağlık sağolun

 

[sakoz]

Hocalarım peki birden fazla parça kodu kopyalandığında Runtime Error 13.Type mismatch hatası veriyor.

Bunu düzeltmenin bir yolunu bulabilir miyiz ?
Teşekkürler...

 

[Orion1]

Hocalarım peki birden fazla parça kodu kopyalandığında Runtime Error 13.Type mismatch hatası veriyor.

Bunu düzeltmenin bir yolunu bulabilir miyiz ?
Teşekkürler...

Ben benim yazdığım kodda denedim.hata vermiyor.zaten vermesi içinde bir neden yok.siz başka bir kodu çalıştırıyorsunuz sanırım.Hata veren dosyayı hata veren satırıda ekleyip yollarmısınız?

 

[sakoz]

Evren hocam selamlar ,

Yok hocam kod çalışıyor. Benim anlatmaya çalıştığım FIYATLAMA sayfasında parça kodu kısmına aynı anda birden fazla parça kodu kopyalandığı zaman type mismatch hatası veriyor.

Genelde fiyatlamayı yapan arkadaşlarda aradıkları parça kodlarının hepsini birden yapıştırıyor

Dosyayıda ekliyorum hocam.İlginize teşekkür ederim...

http://www.dosya.tc/server9/dvdmup/SABLON59.rar.html

 

[Orion1]

Evren hocam selamlar ,

Yok hocam kod çalışıyor. Benim anlatmaya çalıştığım FIYATLAMA sayfasında parça kodu kısmına aynı anda birden fazla parça kodu kopyalandığı zaman type mismatch hatası veriyor.

Genelde fiyatlamayı yapan arkadaşlarda aradıkları parça kodlarının hepsini birden yapıştırıyor

Dosyayıda ekliyorum hocam.İlginize teşekkür ederim...

http://www.dosya.tc/server9/dvdmup/SABLON59.rar.html

4 numaralı mesaja linklediğim dosyayı tekrar indiriniz.

 

[sakoz]

4 numaralı mesaja linklediğim dosyayı tekrar indiriniz.

Evren Hocam yemin ediyorum süpersiniz ellerinize , emeğinize sağlık sağolun k::

 

[Orion1]

Kopyala yapıştır ile dosyada çalışıyorsanız , en iyi yöntem formül ile verileri getirmek olacaktır.Bunun için düşeyara formülünü kullanınız.Benim yaptığım kodlar, kopyala yapıştıra uygun değildir.

 

[sakoz]

Evet hocam bende şimdi onu yazacaktım. Sirküler sayfasından 8-10 tane parça kodunu kopyala FİYATLAMA sayfasında parça kodunu yapıştırınca ilk satırdaki neyse, geri kalanların hepsini aynı getiriyor...

Bunu düzeltme imkanımız yokmu peki ??

 

[Orion1]

Evet hocam bende şimdi onu yazacaktım. Sirküler sayfasından 8-10 tane parça kodunu kopyala FİYATLAMA sayfasında parça kodunu yapıştırınca ilk satırdaki neyse, geri kalanların hepsini aynı getiriyor...

Bunu düzeltme imkanımız yokmu peki ??

Yok.Formül kullanınız.

 

[sakoz]

Tamam evren hocam teşekkür ederim.