Makro ile Düşeyara

usubaykan · 8 Kasım 2010

huseyincoban' Alıntı:
Teşekkürler Sy usubaykan, tam istediğim gibi çalışıyor. Zahmetler verdim, İyi akşamlar dilerim.

Rica ederim

DWARFEST · 9 Kasım 2010

Merhaba, fikir belirten ve yardımcı olan herkese teşekkürler.
Birşeyler öğrenmek adına takipteyim

Bir sorum olacak:

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"), 3, 0)
Else
Cells(U, "E") = "Aradığınız değer bulunamadı."
End If
Next
End Sub

verilen örnekte çalışıyor. Peki "hesap planı"sayfasındaki başka verileri de Veri Yönetimi sayfasına nasıl aktarabiliriz?
Örneğin 120.01.001 yazıp makroyu çalıştırınca "A001" ve "Hüseyin ÇOBAN" verisi de sayfaya işlensin.

Emir Hüseyin Çoban · 9 Kasım 2010

Stok sütunun yanına bir sütun daha ekleyip

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
[COLOR="Red"]            Cells(U, "E") = WorksheetFunction.VLookup(Cells(U, "D"), Sheets("hesap planı").Range("B:D"), 2, 0)
            Cells(U, "F") = WorksheetFunction.VLookup(Cells(U, "D"), Sheets("hesap planı").Range("B:E"), 3, 0)[/COLOR]
            Else
            Cells(U, "E") = ""
        End If
    Next
End Sub

şeklinde düzenleyiniz. Bende tam bilmiyorum yeni öğreniyorum.

DWARFEST · 9 Kasım 2010

Teşekkürler.

Cells(U, "E") = WorksheetFunction.VLookup(Cells(U, "D"), Sheets("hesap planı").Range("B"), 2, 0)
Cells(U, "F") = WorksheetFunction.VLookup(Cells(U, "D"), Sheets("hesap planı").Range("B:E"), 3, 0)

kısmını bende düzenlemiştim ama veri çektiğim sayfada veri olmazsa çalışmıyormuş

bir de sütün sayısı ile orantılı olacak şekilde .. 2,0 - 3,0 şeklinde sütunları tanımlamayı unutmuşum...

s.savas · 9 Kasım 2010

Ergün Güler' Alıntı:

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

İyi akşamlar.
Ergün hocam yukarıda yazdığınız koda, A7 satırından itibaren sağındaki sütuna bakarak hücre dolu ise A sütununa otomatik sıra numarası verecek ek bir kod yazılabilirmi.

Ergün Güler · 10 Kasım 2010

s.savas' Alıntı:
İyi akşamlar.
Ergün hocam yukarıda yazdığınız koda, A7 satırından itibaren sağındaki sütuna bakarak hücre dolu ise A sütununa otomatik sıra numarası verecek ek bir kod yazılabilirmi.

Selam,
kodlardaki

sat = sat + 1

bulunuz. ve altına aşağıdaki kırmızı olan kodu ekleyiniz. İsteğiniz bu olması lazım.

Kod:

sat = sat + 1

[COLOR="Red"]mkys.Cells(sat, "A") =  sat - 6[/COLOR]

s.savas · 10 Kasım 2010

Teşekkür ederim üstat işlem tamamdır.

Emir Hüseyin Çoban · 10 Kasım 2010

Merhaba Arkadaşlar,

Paylaştığınız düşeyara formüllerini diğer tablolarımıda uygulattım.
Ekteki tablomda "veri girişi" sayfasında D sütununda düşeyara makrosu çalışıyor. Ancak aynı sayfada G sütununa da işlemi eklemek istiyorum ama bir türlü yapamadım.

Kod:

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("D2:D65536")) Is Nothing Then
    On Error Resume Next
        If Target = "" Then Exit Sub
        If WorksheetFunction.CountIf(Sheets("HESAP PLANI").Range("B:B"), Cells(Target.Row, "D")) > 0 Then
            Cells(Target.Row, "E") = WorksheetFunction.VLookup(Cells(Target.Row, "D"), Sheets("HESAP PLANI").Range("B:D"), 2, 0)
            Else
            Cells(Target.Row, "E") = ""
        End If
    End If
End Sub

kodlarda nasıl bir düzenleme yapmalıyım.

Yardım ve fikirlerinizi bekliyorum.

usubaykan · 10 Kasım 2010

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

Paylaştığınız düşeyara formüllerini diğer tablolarımıda uygulattım.
Ekteki tablomda "veri girişi" sayfasında D sütununda düşeyara makrosu çalışıyor. Ancak aynı sayfada G sütununa da işlemi eklemek istiyorum ama bir türlü yapamadım.

Kod:

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("D2:D65536")) Is Nothing Then On Error Resume Next If Target = "" Then Exit Sub If WorksheetFunction.CountIf(Sheets("HESAP PLANI").Range("B:B"), Cells(Target.Row, "D")) > 0 Then Cells(Target.Row, "E") = WorksheetFunction.VLookup(Cells(Target.Row, "D"), Sheets("HESAP PLANI").Range("B:D"), 2, 0) Else Cells(Target.Row, "E") = "" End If End If End Sub

kodlarda nasıl bir düzenleme yapmalıyım.

Yardım ve fikirlerinizi bekliyorum.

Merhaba;

Aşağıdaki kodu deneyiniz.

Kod:

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
    If Not Intersect(Target, Range("D2:D65536")) Is Nothing Then
            If Target = "" Then Exit Sub
                If WorksheetFunction.CountIf(Sheets("HESAP PLANI").Range("B:B"), Cells(Target.Row, "D")) > 0 Then
                Cells(Target.Row, "E") = WorksheetFunction.VLookup(Cells(Target.Row, "D"), Sheets("HESAP PLANI").Range("B:D"), 2, 0)
                Else
                Cells(Target.Row, "E") = "Veri Yok"
            End If
    Else
        If Not Intersect(Target, Range("G2:G65536")) Is Nothing Then
            If Target = "" Then Exit Sub
            If WorksheetFunction.CountIf(Sheets("HESAP PLANI").Range("B:B"), Cells(Target.Row, "D")) > 0 Then
            Cells(Target.Row, "H") = WorksheetFunction.VLookup(Cells(Target.Row, "G"), Sheets("HESAP PLANI").Range("B:D"), 2, 0)
            Else
            Cells(Target.Row, "H") = "Veri Yok"
            End If
        End If
    End If
End Sub

Emir Hüseyin Çoban · 10 Kasım 2010

Sy Usubaykan, yine sorunumu hemen çözdünüz. İlgi ve yardımınız için teşekkür ederim.
İyi akşamlar.

usubaykan · 10 Kasım 2010

huseyincoban' Alıntı:
Sy Usubaykan, yine sorunumu hemen çözdünüz. İlgi ve yardımınız için teşekkür ederim.
İyi akşamlar.

Sizede iyi akşamlar rica ederim

s.savas · 11 Kasım 2010

Merhaba arkadaşlar.
Notebok'ta windows7 ve Ofis2003 yüklü. Notebok'ta ekteki belgelerde bulunan Mukayese-1 isimli sekmesindeki makro sorunsuz çalışıyor.

Masaüstü pc de ise windows7 ve Ofis2007 yüklü. Masaüstü pc de örnek2 de bulunan Mukayese-1 isimli sekmesindeki makro sorunsuz çalışıyor, fakat örnek1 de bulunan Mukayese-1 isimli sekmesindeki makro çalışmıyor. Satır- Sütun ve hücre yapıları her iki belgede de aynı.
Problem hakkında görüş ve önerilerinizi almak istiyorum.

Emir Hüseyin Çoban · 11 Kasım 2010

Merhaba,

Kod:

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("D2:D65536")) Is Nothing Then
    On Error Resume Next
        If Target = "" Then Exit Sub
        If WorksheetFunction.CountIf(Sheets("HESAP PLANI").Range("B:B"), Cells(Target.Row, "D")) > 0 Then
            Cells(Target.Row, "E") = WorksheetFunction.VLookup(Cells(Target.Row, "D"), Sheets("HESAP PLANI").[COLOR="Red"]Range("B:D")[/COLOR], 2, 0)
            Else
            Cells(Target.Row, "E") = ""
        End If
    End If
End Sub

bu kodlar ilgili verinin sağ tarındaki veri getirtebiliyoruz. Ama sol tarafındaki veriyi getirmek için nasıl bir düzenleme yapmalıyız.

usubaykan · 11 Kasım 2010

Merhaba;

Kullandığınız kod düşeyara olduğu için sol tarafındaki verileri getiremezsiniz. Bunun için İndis fonksiyonunu kullanmalısınız. Biz burada yazıyoruz ama size ne kadar faydalı oluyor bilmiyorum. Bu kodu yazdıktan sonra size tavsiyem fonksiyonları incelemeniz. Sizlere yardım etmekten sıkıldığım anlamına gelmiyor yanlış anlamayın. Biraz araştırıp biraz zorlarsanız kendinizi bilginiz üstüne bilgi katarsınız.

Kod:

"WorksheetFunction.VLookup(Cells(Target.Row, "G"), Sheets("HESAP PLANI").Range("B:D"), 2, 0)"

yerine

Kod:

WorksheetFunction.Index(Sheets("HESAP PLANI").[COLOR=DarkRed]Range("A:J")[/COLOR],WorksheetFunction.Match(Target, Sheets("HESAP PLANI").[COLOR=RoyalBlue]Range("A:A")[/COLOR], 0), [COLOR=Red]3[/COLOR])

kodunu deneyiniz.
Aradığınız ve görmek istediğiniz verinin dizi aralığıdır.
Aradağınız hedefin sütunun belirler.
İstediğiniz sütundaki değeri getirir.

Emir Hüseyin Çoban · 11 Kasım 2010

Tekrardan çok teşekkürler Sy Usubaykan, sizin ve forum sayesinde düşeyara konusunda bilgim birhayli arttı.

usubaykan · 11 Kasım 2010

huseyincoban' Alıntı:
Tekrardan çok teşekkürler Sy Usubaykan, sizin ve forum sayesinde düşeyara konusunda bilgim birhayli arttı.

Rica ederim.

gedavet · 12 Kasım 2010

=eğer(e6="";"";düşeyara(e6;ürünler!$c$5:$e$21;3;0))

iyi günler bende bu şekilde formülle yapıyordu bu konuyu inceledim güzel bir örnek mu formülün makro ile olması benim ekdeki dosyayada uygulamak istiyorum yapamadım yardımlarınız için teşekkür ederi

yani yapmak isdeğim ürünler sayfasındaki ürünü veri doğrulamadan liste ile ürünü alış sayfasındaki alınan ürün adı sütununa getirdiyorum ve hangi ürünü yazarsam birim fiyatı ürün sayfasındaki belirttiğim fiyat gelmesini istiyorum makro ile

Emir Hüseyin Çoban · 12 Kasım 2010

mustafakoza' Alıntı:
=eğer(e6="";"";düşeyara(e6;ürünler!$c$5:$e$21;3;0))

iyi günler bende bu şekilde formülle yapıyordu bu konuyu inceledim güzel bir örnek mu formülün makro ile olması benim ekdeki dosyayada uygulamak istiyorum yapamadım yardımlarınız için teşekkür ederi

yani yapmak isdeğim ürünler sayfasındaki ürünü veri doğrulamadan liste ile ürünü alış sayfasındaki alınan ürün adı sütununa getirdiyorum ve hangi ürünü yazarsam birim fiyatı ürün sayfasındaki belirttiğim fiyat gelmesini istiyorum makro ile

Elimden geldiğince ve sorunuzu anladığım kadarıyla yapmaya çalıştım.
eki inceleyiniz.

gedavet · 12 Kasım 2010

ilginiz için teşekkür ederim ancak ürünler sayfasında olmayan bir şey yazınca uyarı veri ve yazdırmasa yazdığımız şey kalıyor ve kodda bir satırı çalıştırmamışsınız ondan olabilirmi

yani ürünler sayfasında olmayan bir şey yazdırmasa

cmzrfdl · 12 Kasım 2010

merhabalar,

excel 2007'de çalışıyorum ve dosyalar çoğu zaman 800.000 satırın üzerinde olabiliyor. 800.000 satırlık bir dosyadaki veriyi 500.000 satır üzeri başka bir dosyada aratıp düşeyara yaptırdığımda bilgisayar uzun süre kendine gelmemek üzere kilitleniyor. bu konu altında yazılan kodlara anladığım kadarıyla baktım hatta bir tanesini de kendi dosyama uyarlayıp denedim; fakat kodun içerisinde de vlookup geçtiği için hız açısından çok fazla katkı sağlamadı.

acaba makro ile bu sorunu kısa sürede çözebileceğim bir alternatif mevcut mudur?

saygılarımla,

Makro ile Düşeyara

usubaykan

Destek Ekibi

DWARFEST

Emir Hüseyin Çoban

Destek Ekibi

Ekli dosyalar

DWARFEST

s.savas

Ergün Güler

s.savas

Emir Hüseyin Çoban

Destek Ekibi

Ekli dosyalar

usubaykan

Destek Ekibi

Emir Hüseyin Çoban

Destek Ekibi

usubaykan

Destek Ekibi

s.savas

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

usubaykan

Destek Ekibi

Emir Hüseyin Çoban

Destek Ekibi

usubaykan

Destek Ekibi

gedavet

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

Ekli dosyalar

gedavet

cmzrfdl