kayıtları karşılaştırıp indirim oranlarını yazmak

ockucukay · 26 Şubat 2009

Merhaba arkadaşlar

mükerrer kayıt makrolarını inceledim ama bu işlemi yapabilen yok. Yapmak istediğim şey şu: m ve n sütunlarında bulunan ürün grubu ve bu gruplara ait indirim oranları var. Makro çalıştığında örneğin d6'da bulunan A11 ürün kodunu görüp g6'ya N sütununda bulunan indirim oranını yazsın istiyorum. düşeyara kullanarak yapabiliyorum ama 30000 satır birden çalışınca dosya çok şişiyor. Yardımcı olacak arkadaşlara şimdiden teşekkür ediyorum.

ockucukay · 26 Şubat 2009

düşeyara ile ilgili güzel makrolu örnekler buluyorum ancak malum sebepten ötürü indiremiyorum. fikri olan arkadaşım var mı?

ockucukay · 26 Şubat 2009

arkadaşlar aşağıdaki gibi bir kod yazdım ama 1004 hatası veriyor, neyi eksik yazdım acaba?

Sub Duseyara()
Dim Duseyara As Range
For Each Duseyara In Sheets("Sayfa1").Range("m6:m10")
Duseyara.Offset(0, 1) = WorksheetFunction.VLookup _
(Duseyara, Sheets("Sayfa1").Range("d6:f1000"), 3, 0)
Next Duseyara
End Sub

ockucukay · 26 Şubat 2009

Birde aşağıdaki kodu buldum ama sadece mesaj verip duruyor, neyi yapamıyorum acaba?

Sub vlookup_()'DÜŞEY ARA
On Error GoTo hata
For sut = 1 To 3
Range("m" & sut) = WorksheetFunction.vlookup(Range("d" & sut), Range("d:f"), 2, 0)
Next
Exit Sub
hata:
MsgBox "m sütununda verisiz hücreyi doldurmalısınız."
End Sub

ockucukay · 2 Mart 2009

sadece hatırlatma, bilgisi olan var mı?

Korhan Ayhan · 2 Mart 2009

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod:

Option Explicit
 
Sub DÜŞEYARA()
    Dim Son_Satır As Long
    [G6:G65536].ClearContents
    Son_Satır = [A65536].End(3).Row
    With Range("G6:G" & Son_Satır)
        .Formula = "=IF(ISERROR(VLOOKUP(D6,M:N,2,0)),0,VLOOKUP(D6,M:N,2,0))"
        .Value = .Value
    End With
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

ockucukay · 2 Mart 2009

Korhan Ayhan' Alıntı:

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod:

Option Explicit
 
Sub DÜŞEYARA()
    Dim Son_Satır As Long
    [G6:G65536].ClearContents
    Son_Satır = [A65536].End(3).Row
    With Range("G6:G" & Son_Satır)
        .Formula = "=IF(ISERROR(VLOOKUP(D6,M:N,2,0)),0,VLOOKUP(D6,M:N,2,0))"
        .Value = .Value
    End With
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

Öncelikle ilginize çok teşekkür ederim. Aşağıda bazı sorularım var, cevaplarsanız müteşekkir olacağım.
1-Makroyu çalıştırdım, ancak bazı yerlerde hatalı yerleştirme yaptı. Örneğin B82 ürün kodunun indirim oranı tabloda 53 olarak görülmesine rağmen (mesela 100 kayıt varsa) ilk 40 adedi 40, 30 adedi 45 kalanı 35 olarak görülüyor.sebebi nedir acaba?
2-İndirim oranlarını yazdırdıktan sonra H sütununa indirimli fiyatları yazdırabilirmiyiz?

Korhan Ayhan · 2 Mart 2009

Selamlar,

Önerdiğim kodu eklemiş olduğunuz dosyada 40.000 satır üzerinde denedim ve olumlu sonuç aldım.

2. sorunuz için kodu aşağıdaki şekilde kullanabilirsiniz.

Kod:

Option Explicit
 
Sub DÜŞEYARA()
    Dim Son_Satır As Long
    [G6:H65536].ClearContents
    Son_Satır = [A65536].End(3).Row
    With Range("G6:G" & Son_Satır)
        .Formula = "=IF(ISERROR(VLOOKUP(D6,M:N,2,0)),0,VLOOKUP(D6,M:N,2,0))"
        .Value = .Value
    End With    
    With Range("H6:H" & Son_Satır)
        .Formula = "=E6-(E6*G6)"
        .Value = .Value
    End With
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

Eğer verdiğim kodda sorun yaşarsanız aşağıdaki koduda kullanabilirsiniz.

Kod:

Option Explicit
 
Sub DÜŞEYARA()
    Dim Son_Satır As Long, X As Long, Bul As Range
    [G6:H65536].ClearContents
    Son_Satır = [A65536].End(3).Row
    For X = 6 To Son_Satır
    Set Bul = [M:M].Find(Cells(X, 4), LookAt:=xlWhole)
    If Not Bul Is Nothing Then
    Cells(X, 7) = Cells(Bul.Row, 14)
    Cells(X, 8) = Cells(X, 5) - (Cells(X, 5) * Cells(X, 7))
    End If
    Next
    Set Bul = Nothing
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

Korhan Ayhan · 2 Mart 2009

Selamlar,

#8 nolu mesajımdaki önerdiğim 2. kod bloğunu kullanın daha hızlı sonuç vermektedir. 1. önerdiğim kod satır sayısı fazla olduğu için biraz yavaş sonuç vermektedir.

ockucukay · 2 Mart 2009

Korhan Ayhan' Alıntı:

Selamlar,

Önerdiğim kodu eklemiş olduğunuz dosyada 40.000 satır üzerinde denedim ve olumlu sonuç aldım.

2. sorunuz için kodu aşağıdaki şekilde kullanabilirsiniz.

Kod:

Option Explicit
 
Sub DÜŞEYARA()
    Dim Son_Satır As Long
    [G6:H65536].ClearContents
    Son_Satır = [A65536].End(3).Row
    With Range("G6:G" & Son_Satır)
        .Formula = "=IF(ISERROR(VLOOKUP(D6,M:N,2,0)),0,VLOOKUP(D6,M:N,2,0))"
        .Value = .Value
    End With    
    With Range("H6:H" & Son_Satır)
        .Formula = "=E6-(E6*G6)"
        .Value = .Value
    End With
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

Eğer verdiğim kodda sorun yaşarsanız aşağıdaki koduda kullanabilirsiniz.

Kod:

Option Explicit
 
Sub DÜŞEYARA()
    Dim Son_Satır As Long, X As Long, Bul As Range
    [G6:H65536].ClearContents
    Son_Satır = [A65536].End(3).Row
    For X = 6 To Son_Satır
    Set Bul = [M:M].Find(Cells(X, 4), LookAt:=xlWhole)
    If Not Bul Is Nothing Then
    Cells(X, 7) = Cells(Bul.Row, 14)
    Cells(X, 8) = Cells(X, 5) - (Cells(X, 5) * Cells(X, 7))
    End If
    Next
    Set Bul = Nothing
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

Kodunuzu f8 ile adım adım izledim. aşağıdaki durum ortaya çıktı. end with ile biten satırlara gelene kadar herşey doğru, fakat end with geçince daha önce bahsettiğim olaylar gerçekleşiyor. Bütün bu durum toplam 60.000 satır için geçerli, ilginize tekrar teşekkür ederim. cevabınızı merakla bekliyorum.

Sub DÜŞEYARA()
Dim Son_Satır As Long
[G6:H65536].ClearContents
Son_Satır = [A65536].End(3).Row
With Range("G6:G" & Son_Satır)
.Formula = "=IF(ISERROR(VLOOKUP(D6,M:N,2,0)),0,VLOOKUP(D6,M:N,2,0))"
.Value = .Value
End With (Buraya gelene kadar herşey doğru, End with satırını geçince size söylediğim değerler geliyor)
With Range("H6:H" & Son_Satır)
.Formula = "=E6-(E6*(G6/100))" (Bu kısmı ben değiştirdim, dikkate almayın)
.Value = .Value
End With (Buraya gelene kadar herşey doğru, End with satırını geçince size söylediğim değerler geliyor)
MsgBox "İşleminiz tamamlanmıştır."
End Sub

Korhan Ayhan · 2 Mart 2009

Selamlar,

#9 nolu mesajımdaki önerimi dikkate alın.

ockucukay · 3 Mart 2009

Korhan Ayhan' Alıntı:
Selamlar,

#9 nolu mesajımdaki önerimi dikkate alın.

Önerinizi uyguladım, "type mismatch" hatası verdi. 1.verdiğiniz kod yavaş olsada güzel çalışıyor, emeğinize sağlık. ama sanırım yavaş çalışmasının sebebi sizin kodunuz değil, veritabanı 40000-50000 satır civarında 6-6,5 mb boyutuna geliyor, sebep bu olmalı. üstelik daha eklenecek 35000-40000 satır arası bilgi var! exceli arayüz gibi kullanıp accesse veri kaydetmek gerekecek sanırım. bu konuda bilginiz varsa yardımlarınızı esirgemeyin lütfen. ilginize ve emeğinize tekrar teşekkürler ediyorum.

Not: sayın haluk'un çalışmalarını incelemeye çalıştım, ama malum dosyalar silinmiş.

ockucukay · 3 Mart 2009

ockucukay' Alıntı:
...exceli arayüz gibi kullanıp accesse veri kaydetmek gerekecek sanırım. bu konuda bilginiz varsa yardımlarınızı esirgemeyin lütfen. ilginize ve emeğinize tekrar teşekkürler ediyorum...

yukarıda anlatmak istediğim şeyi ekteki dosyada yapmaya çalıştım ama birşeyler eksik kalıyor. listboxda tanımlamama rağmen tüm alanları gösteremiyorum. kaydetme makrosu bir çalışıyor bir çalışmıyor. yardımlarınızı dört gözle bekliyorum.

ockucukay · 3 Mart 2009

ockucukay' Alıntı:
yukarıda anlatmak istediğim şeyi ekteki dosyada yapmaya çalıştım ama birşeyler eksik kalıyor. listboxda tanımlamama rağmen tüm alanları gösteremiyorum. kaydetme makrosu bir çalışıyor bir çalışmıyor. yardımlarınızı dört gözle bekliyorum.

arkadaşlar bu konuda yardımcı olabilecek varmı acaba? üstatlarımın yardımlarını bekliyorum...

kayıtları karşılaştırıp indirim oranlarını yazmak

ockucukay

Ekli dosyalar

ockucukay

ockucukay

ockucukay

ockucukay

Korhan Ayhan

Administrator

ockucukay

Ekli dosyalar

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

ockucukay

Korhan Ayhan

Administrator

ockucukay

ockucukay

Ekli dosyalar

ockucukay