• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile Düşeyara

S

s.savas

Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
Arkdaşlar iyi akşamlar.
Mukayese-1 isimli sekmenin C sütununda 7.satırda var olan formül ile diğer sayfadan istediğim bilgi alıyorum. Yoğun olarak kullandığım formülleri makroya terfi etmek istiyorum.
Kod: 
=EĞER(B7="";0;DÜŞEYARA(B7;'Mukayese Cetveli'!A4:'Mukayese Cetveli'!AW201;2;0))
 
Merhaba;

Örneğin kodunuzu A2 hücresi için uygularsak
Kod: 
Range("A2") = IIf(Range("B7") = "", 0, WorksheetFunction.VLookup(Range("B7"), Sheets("Mukayese Cetveli").Range("A:AW"), 2, 0))
şeklinde olmalıdır.
 
İyi akşamlar hocam.
Yazdığınız kodu C7:C (C7:C150 arasında aynı formüllerin olduğunu düşünürsek) aralığı için nasıl uygularız.
 
s.savas' Alıntı:
Arkdaşlar iyi akşamlar.
Mukayese-1 isimli sekmenin C sütununda 7.satırda var olan formül ile diğer sayfadan istediğim bilgi alıyorum. Yoğun olarak kullandığım formülleri makroya terfi etmek istiyorum.
Kod: 
=EĞER(B7="";0;DÜŞEYARA(B7;'Mukayese Cetveli'!A4:'Mukayese Cetveli'!AW201;2;0))
Genişletmek için tıkla ...

Selam,

Örnek verdiğiniz formülün kırmızı alandaki tablo dizisi hatalı. Yeniden kontrol ediniz.
Kod: 
=EĞER(B7="";0;DÜŞEYARA(B7;[COLOR="Red"]'Mukayese Cetveli'!A4:'Mukayese Cetveli'!AW201[/COLOR];2;0))
hatalı formül ile ne yapmak istediğiniz anlaşılmıyor. Bu yüzden kod da yazılamaz.
örnek dosyanızı ekleyiniz.

Ancak Sayın usubaykan'ın kodunu her satırı için istiyorsanız, aşağıdaki kodları kendinize uyarlayınız.
Kod: 
Sub dusey_ara()

son = Range(65536, "B").End(3).Row

For sat = 7 To son

Range("C" & sat) = IIf(Range("B" & sat) = "", 0, WorksheetFunction.VLookup(Range("B" & sat), Sheets("Mukayese Cetveli").Range("A7:AW" & son), 2, 0))

Next

End Sub
 
Son düzenleme:
Selamlar, Ergün hocam.
Kod: 
=EĞER(B7="";0;DÜŞEYARA(B7;'Mukayese Cetveli'!A4:'Mukayese Cetveli'!AW201;2;0))
Formülü C7 hücresi için, B7 hücresindeki değerin karşılığını Mukayese Cetvelinden alıyorum ve formül doğru sonuç veriyor.
C7:C150 aralığında 150 adet formül var.
Sizin yazdığınız kodu sekmenin kod bölümüne yazınca
Kod: 
Son = Range(65536, "B").End(3).Row
satırında hata veriyor.


Usubaykan hocanın yazdığı kod sadece bir hücrede işlev görüyordu. Bu kodu C7:C150 aralığı için uygulamak istemiştim.
 

Ekli dosyalar

s.savas' Alıntı:
Selamlar, Ergün hocam.
Kod: 
=EĞER(B7="";0;DÜŞEYARA(B7;'Mukayese Cetveli'!A4:'Mukayese Cetveli'!AW201;2;0))
Formülü C7 hücresi için, B7 hücresindeki değerin karşılığını Mukayese Cetvelinden alıyorum ve formül doğru sonuç veriyor.
C7:C150 aralığında 150 adet formül var.
Sizin yazdığınız kodu sekmenin kod bölümüne yazınca
Kod: 
Son = Range(65536, "B").End(3).Row
satırında hata veriyor.


Usubaykan hocanın yazdığı kod sadece bir hücrede işlev görüyordu. Bu kodu C7:C150 aralığı için uygulamak istemiştim.
Genişletmek için tıkla ...


Merhaba;
Kod: 
[/FONT]Son = Range(65536, "B").End(3).Row
kodunu
Kod: 
[/FONT]Son = [COLOR=Red]Cells[/COLOR](65536, "B").End(3).Row
şeklinde deneyin.
 
usubaykan' Alıntı:
Merhaba;
Kod: 
[/FONT]Son = Range(65536, "B").End(3).Row
kodunu
Kod: 
[/FONT]Son = [COLOR=Red]Cells[/COLOR](65536, "B").End(3).Row
şeklinde deneyin.
Genişletmek için tıkla ...


Üstat bu seferde aşağıdaki satırda hata mesajı veriyor.
Kod: 
Range("C" & sat) = IIf(Range("B" & sat) = "", 0, WorksheetFunction.VLookup(Range("B" & sat), Sheets("Mukayese Cetveli").Range("A7:AW" & son), 2, 0))
 
s.savas' Alıntı:
Üstat bu seferde aşağıdaki satırda hata mesajı veriyor.
Kod: 
Range("C" & sat) = IIf(Range("B" & sat) = "", 0, WorksheetFunction.VLookup(Range("B" & sat), Sheets("Mukayese Cetveli").Range("A7:AW" & son), 2, 0))
Genişletmek için tıkla ...

Merhaba;

Aşağıdaki şekli ile kullanın.
Kod: 
Sub dusey_ara()

son = Cells(65536, "B").End(3).Row

For sat = 1 To son

Range("A" & sat) = IIf(Range("B" & sat) = "", 0, WorksheetFunction.VLookup(Range("B" & sat), Sheets("Mukayese Cetveli").Range("A:AW"), 2, 0))

Next

End Sub
 
Düşeyara formülü çok kullanışlı bir işlem sağlıyor, ancak tabloda hücrelere uygulattıkça tablo boyutu yükseliyor.
O yüzden makrosunu kullanmak daha kullanışlı bence.
 
Usubaykan hocam teşekkür ederim emeğinize.
Fakat, WorksheetFunction sınıfının VLookup özelliği alınamıyor diye hata mesajı alıyorum.

Bu makro ile 5. mesajda ekli dosyada bulunan Mukayese-1 sekmesinde A1 hücresinde veri doğrulama ile listelediğim firmanın üzerinde kalan malzemeleri listelemesi gerekiyor.
 
s.savas' Alıntı:
Selamlar, Ergün hocam.
Kod: 
=EĞER(B7="";0;DÜŞEYARA(B7;'Mukayese Cetveli'!A4:'Mukayese Cetveli'!AW201;2;0))
Formülü C7 hücresi için, B7 hücresindeki değerin karşılığını Mukayese Cetvelinden alıyorum ve formül doğru sonuç veriyor.
C7:C150 aralığında 150 adet formül var.
Sizin yazdığınız kodu sekmenin kod bölümüne yazınca
Kod: 
Son = Range(65536, "B").End(3).Row
satırında hata veriyor.


Usubaykan hocanın yazdığı kod sadece bir hücrede işlev görüyordu. Bu kodu C7:C150 aralığı için uygulamak istemiştim.
Genişletmek için tıkla ...

Selam,
çözüm bir sonraki mesajımdadır.
 
Son düzenleme:
Selam,
Mukayese-1 sayfasının kod sayfasına aşağıdaki kodları ekleyiniz ve A1 hücresinden seçiminizi yapınız.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mcet As Worksheet
Dim mkys As Worksheet
Dim i As Long
Dim sat As Long

Set mcet = Sheets("Mukayese Cetveli")
Set mkys = Sheets("Mukayese-1")

Son = mcet.Range("AM65536").End(3).Row
sat = 6

If Intersect(Target, mkys.Range("A1")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

mkys.Range("A7:J65536").ClearContents
mkys.Range("F1:F3").ClearContents
For i = 2 To Son

If mkys.Range("A1") = mcet.Range("AM" & i) Then
sat = sat + 1

'mkys.Cells(sat, "A") =
mkys.Cells(sat, "B") = mcet.Cells(i, "A")
mkys.Cells(sat, "C") = mcet.Cells(i, "B")
mkys.Cells(sat, "D") = mcet.Cells(i, "C")
mkys.Cells(sat, "E") = mcet.Cells(i, "D")

mkys.Cells(sat, "F") = mcet.Cells(i, "AK")
mkys.Cells(sat, "G") = mcet.Cells(i, "AM")

mkys.Cells(sat, "H") = mcet.Cells(i, "AQ")
mkys.Cells(sat, "I") = mcet.Cells(i, "AS")
mkys.Cells(sat, "J") = mcet.Cells(i, "AW")

End If
Next
mkys.Cells(1, "F") = WorksheetFunction.SumProduct(mkys.Range("D7:D65536"), mkys.Range("F7:F65536"))
mkys.Cells(2, "F") = sat - 6
mkys.Cells(3, "F") = WorksheetFunction.SumProduct(mkys.Range("D7:D65536"), mkys.Range("J7:J65536"))

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox "Sayfa Güncellenmiştir." & vbLf & sat - 6 & " Adet Sonuç Bulunmuştur.", vbInformation

End Sub
 
Merhaba Arkadaşlar,

Düşeyara formülünü makro ile uygulama işlemini uzun zamandır forumda arıyordum. İşlemi formüller ile yapmak tablo boyutunu çok yükseltiyor ve arada formül silinme gibi hatalar olabiliyor.

Paylaştığınız kodları tabloma uygulamaya çalıştım ancak işlemin A1 hücresinde değişik ile çalışması kısmını uyarlayamadım.

Örnek bir tablo ekliyorum, yardımcı olur musunuz.
Düşeyara formülünü makroya çevirme işlemini öğrenmek isterim.

D sütununda yazdığım verinin karşısına hesap planında stok ilişkisi kodu girilmiş ise o kodu getirmeli.

Yardım ve fikirlerinizi bekliyorum.
 

Ekli dosyalar

huseyincoban' Alıntı:
Merhaba Arkadaşlar,

Düşeyara formülünü makro ile uygulama işlemini uzun zamandır forumda arıyordum. İşlemi formüller ile yapmak tablo boyutunu çok yükseltiyor ve arada formül silinme gibi hatalar olabiliyor.

Paylaştığınız kodları tabloma uygulamaya çalıştım ancak işlemin A1 hücresinde değişik ile çalışması kısmını uyarlayamadım.

Örnek bir tablo ekliyorum, yardımcı olur musunuz.
Düşeyara formülünü makroya çevirme işlemini öğrenmek isterim.

D sütununda yazdığım verinin karşısına hesap planında stok ilişkisi kodu girilmiş ise o kodu getirmeli.

Yardım ve fikirlerinizi bekliyorum.
Genişletmek için tıkla ...


Merhaba;

Aşağıdaki kodu denermisiniz?
Kod: 
Sub Düşeyara()
Dim U As Long
    For U = 6 To [D65536].End(3).Row
        If WorksheetFunction.CountIf(Sheets("hesap planı").Range("B:B"), Cells(U, "D")) > 0 Then
            Cells(U, "E") = WorksheetFunction.VLookup(Cells(U, "D"), Sheets("hesap planı").Range("B:D"), 3, 0)
            Else
            Cells(U, "E") = "Aradığınız değer bulunamadı."
        End If
    Next
End Sub
 
s.savas' Alıntı:
Usubaykan hocam teşekkür ederim emeğinize.
Fakat, WorksheetFunction sınıfının VLookup özelliği alınamıyor diye hata mesajı alıyorum.

Bu makro ile 5. mesajda ekli dosyada bulunan Mukayese-1 sekmesinde A1 hücresinde veri doğrulama ile listelediğim firmanın üzerinde kalan malzemeleri listelemesi gerekiyor.
Genişletmek için tıkla ...

Merhaba;

Aşağıdaki kodu denermisiniz? Sanırım istediğiniz gibi bir kod oldu. Gerçi Ergün beyden gerekli desteği almışsınız ama alternatif olarak yazmak istedim.
Kod: 
Sub Düşeyara()
Dim U As Long
    For U = 7 To [B65536].End(3).Row
        If WorksheetFunction.CountIf(Sheets("Mukayese Cetveli").Range("A:A"), Cells(U, "B")) > 0 And Cells(U, "B") <> "" Then
            Cells(U, "C") = WorksheetFunction.VLookup(Cells(U, "B"), Sheets("Mukayese Cetveli").Range("A:AW"), 2, 0)
            Else
            Cells(U, "C") = ""
        End If
    Next
End Sub
 
Son düzenleme:
Sy Usubaykan, ilginiz ve paylaşımınız çok teşekkür ederim tam istediğim işlem buydu.

Ancak işlemi yapması için Makro çalıştır veya bir nesneye bağlamamız gerekiyor.
D sütununda değişiklik yapınca işlemi çalıştıracak şekilde olması için kodlarla nasıl bir değişiklik yapmalım.
 
huseyincoban' Alıntı:
Sy Usubaykan, ilginiz ve paylaşımınız çok teşekkür ederim tam istediğim işlem buydu.

Ancak işlemi yapması için Makro çalıştır veya bir nesneye bağlamamız gerekiyor.
D sütununda değişiklik yapınca işlemi çalıştıracak şekilde olması için kodlarla nasıl bir değişiklik yapmalım.
Genişletmek için tıkla ...

Merhaba;

Aşağıdaki şekide deneyiniz.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D6:D65536")) Is Nothing Then
    On Error Resume Next
        If Target = "" Then Exit Sub
        If WorksheetFunction.CountIf(Sheets("hesap planı").Range("B:B"), Cells(Target.Row, "D")) > 0 Then
            Cells(Target.Row, "E") = WorksheetFunction.VLookup(Cells(Target.Row, "D"), Sheets("hesap planı").Range("B:D"), 3, 0)
            Else
            Cells(Target.Row, "E") = "Aradığınız değer bulunamadı."
        End If
    End If
End Sub
 
Teşekkürler Sy usubaykan, tam istediğim gibi çalışıyor. Zahmetler verdim, İyi akşamlar dilerim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst