düşey ara ile ilgili

[OZCANLOK]

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
If Intersect(Target, [d5:d100]) Is Nothing Then Exit Sub
For ara = 5 To 300
Range("c" & ara) = WorksheetFunction.VLookup(Range("d" & ara), Sheets("genel bilgiler").Range("a1:c30"), 2, 0)
Range("b" & ara) = WorksheetFunction.VLookup(Range("d" & ara), Sheets("genel bilgiler").Range("a1:c30"), 3, 0)
If Range("d" & ara) = "" Then
Range("d" & ara).Offset(0, -1) = ""
Range("d" & ara).Offset(0, -2) = ""
End If
Next
End Sub

yukarıdaki kodu uyuguladığımızda excel yaklaşık 30 sn de getiriyor
formulu nasıl kısaltabiliriz.

teşekkürler

 

[veyselemre]

Bir hatırlatma, bu forumun en güzel özelliklerinden birisi, mesajlara dosya eklenebilmesi.

 

[OZCANLOK]

özür tablo ekte

ilginiz için teşekkürler

 

[Ferhat Pazarçevirdi]

Her seferinde yaklaşık 300 satır tekrar tekrar kontrol edilsin istemezseniz , şöyle olabilir.

Private Sub Worksheet_Change(ByVal Target As Range)
Set sg = Sheets("Genel Bilgiler")
Set sf = Sheets("Fiyat")
If Intersect(Target, [d5:d300]) Is Nothing Then: Exit Sub
sat = Target.Row
x = Application.WorksheetFunction.Match(Target.Value, sg.Range("A1:A1000"), 0)
sf.Cells(sat, 2) = sg.Cells(x, 3)
sf.Cells(sat, 3) = sg.Cells(x, 2)
Set sg = Nothing
Set sf = Nothing
End Sub

 

[iremitucu]

biri bana örnekle düşey aramayı anlatabilirmi

 

[veyselemre]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [d5:d100]) Is Nothing Or Target.Count > 1 Then Exit Sub
    If Target <> "" Then
        Target.Offset(, -1) = WorksheetFunction.VLookup(Target.Value, Sheets("genel bilgiler").Range("a1:c30"), 2, 0)
        Target.Offset(, -2) = WorksheetFunction.VLookup(Target.Value, Sheets("genel bilgiler").Range("a1:c30"), 3, 0)
    Else
        Target.Offset(, -2).Resize(, 2) = ""
    End If
End Sub

 

[Ferhat Pazarçevirdi]

Sn.iremitucu
Soruyu "Fonksiyonlar" bölümünde yeni bir başlık açarak sorarsanız, bir sürü alternatifle birlikte yardımcı olacaklar çıkacaktır. Sanırım buradaki özel konu altında daha az ilgi görürsünüz. İyi çalışmalar

 

[OZCANLOK]

veysel bey sizin yazmış olduğunuz makro
güzel çalışıyor fakat fiyat sutunundaki

d kolonun da bir aralık seçip sildiğimizde
sadece bir satırdaki değerler siliniyor
bunu nasıl çözebiliriz.
teşekkürler

 

[veyselemre]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [d5:d100]) Is Nothing Then Exit Sub
    Set alan = Sheets("genel bilgiler").Range("a1:c30")
    If Target.Count = 1 Then
        If Target <> "" Then
            Target.Offset(, -1) = WorksheetFunction.VLookup(Target.Value, alan, 2, 0)
            Target.Offset(, -2) = WorksheetFunction.VLookup(Target.Value, alan, 3, 0)
        Else
            Target.Offset(, -2).Resize(, 2) = ""
        End If
    Else
        For Each huc In Target
            If huc = "" Then
                huc.Offset(, -2).Resize(, 2) = ""
            Else
                huc.Offset(, -1) = WorksheetFunction.VLookup(huc.Value, alan, 2, 0)
                huc.Offset(, -2) = WorksheetFunction.VLookup(huc.Value, alan, 3, 0)
            End If
        Next
    End If
End Sub

 

[OZCANLOK]

veysel bey yardımlarınız için çok teşekkür ederim

son göndermiş olduğunuz makro çalıştı fakat şöyle bir problem oluştu

tablonun küçük bir örneğini göndermiştim tablo çok büyük olduğu için

makroyu uyguladığımız zaman calculation çalışıyor ve makro çalışmıyor
yani değerleri getirmiyor calculation manual getirdiğimiz zamnan çalışıyor
bunu nasıl çözebiliriz.

teşekkürler

 

[OZCANLOK]

Bu Konuda Yardim Edecek AkkadaŞ Yokmu

 

[veyselemre]

Yukardaki makro D5100 aralığında çalışır, aşağıdaki makro d sütununda çalışır.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [d:d]) Is Nothing Then Exit Sub
    Set alan = Sheets("genel bilgiler").Range("a1:c" & Sheets("genel bilgiler").[a65536].End(3).Row)
    For Each huc In Target
        If huc = "" Then
            huc.Offset(, -2).Resize(, 2) = ""
        Else
            huc.Offset(, -1) = WorksheetFunction.VLookup(huc.Value, alan, 2, 0)
            huc.Offset(, -2) = WorksheetFunction.VLookup(huc.Value, alan, 3, 0)
        End If
    Next
End Sub

 

[OZCANLOK]

veysel bey problem tablo büyük olduğu için calculation

çalıştığı için makro işlem görmüyor makro çalışmadan önce calculation

iptal edilecek daha sonra tekrar devreye girecek

teşekkürler

 

[veyselemre]

ActiveSheet.EnableCalculation = False

Şeklinde hesaplamayı iptal edebilirsin.

Kodların sonunda da True vererek de aktif edebilirsiniz.

 

[OZCANLOK]

Veysel bey yardımlarınız çok teşekkürler sağolun