• DİKKAT

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

Makro ile Düşeyara

cmzrfdl' Alıntı:
merhabalar,

.... başka bir dosyada aratıp düşeyara yaptırdığımda bilgisayar uzun süre kendine gelmemek üzere kilitleniyor.
.... kodun içerisinde de vlookup geçtiği için hız açısından çok fazla katkı sağlamadı.
Genişletmek için tıkla ...
Selam,
Sayın cmzrfdl,
Birinci olarak kastettiğinizi tam anlayamadım.
İkinci olarak "katkı sağlamadı" diyorsunuz.
Öncelikle şunu söyleyeyim;
1-Dosyanızı eklemelisiniz.
2-Sayfalarınızda hem fonksiyon hem de Makro kullanıyorsanız. kesinlikle çok yavaşlama olacaktır. bunu önlemek için kodlarınızın öncesi ve sonrasına aşağıdaki kodları ekleyiniz.
Kod: 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[COLOR="Red"][B]
'kodlarınız burada olsun[/B][/COLOR]

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

3-Benim bu zamana kadar öğrendiğim şudur: Excel'in yerleşik fonksiyonları ve WorksheetFunction altındaki kodlar (WorksheetFunction.Sum, WorksheetFunction.CountIf gibi) yazılan diğer kodlardan çok daha hızlıdırlar.

4- Gereğinden çok fazla kodlar yazılmış veya döngü kurulmuş olabilir.

(aynı hataları ben de çok yapmıştım. Excel'in hazır kodlarını kullanıp 50-100 ms'de sonuçlanan Makroyu 4-5 dk. ancak alabilmiştim.)

5- Bir Excel Sayfasında(2003 versiyon) en fazla satır sayısı 65.536 değil midir?
siz 800.000 satırdan bahsediyorsunuz

İyi çalışmalar.
 
Son düzenleme:
iki sayfada düşeyarama makrosu

Merhaba Arkadaşlar,
Konu ile aklıma takılan birşeyi daha sormak istiyorum.
Ör. Veri girişi sayfasında E sütununda yazdığım veriyi hesap planı sayfasında arıyor. Uygun kayıt varsa ismini getiriyor.

Peki E sütununa girdiğim veriyi hesap planı ve diğer hesaplar sayfasıyla beraber aratmamız mümkün mü?
 

Ekli dosyalar

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E6:E65536")) Is Nothing Then
        On Error Resume Next
        If Target = "" Then Exit Sub
        If WorksheetFunction.CountIf(Sheets("hesap planı").Range("B:B"), Cells(Target.Row, "E")) > 0 Then
            Cells(Target.Row, "F") = WorksheetFunction.VLookup(Cells(Target.Row, "E"), Sheets("hesap planı").Range("B:D"), 2, 0)
            Cells(Target.Row, "G") = WorksheetFunction.VLookup(Cells(Target.Row, "E"), Sheets("hesap planı").Range("B:D"), 3, 0)
        ElseIf WorksheetFunction.CountIf(Sheets("diğer hesaplar").Range("B:B"), Cells(Target.Row, "E")) > 0 Then
            Cells(Target.Row, "F") = WorksheetFunction.VLookup(Cells(Target.Row, "E"), Sheets("diğer hesaplar").Range("B:D"), 2, 0)
            Cells(Target.Row, "G") = WorksheetFunction.VLookup(Cells(Target.Row, "E"), Sheets("diğer hesaplar").Range("B:D"), 3, 0)
        Else
            MsgBox " Girdiğiniz Hesap Kodu Hesap Planında Bulunamadı !", vbCritical
        End If
    End If
    
    If Intersect(Target, Range("D6:D65536,H6:I65536")) Is Nothing Then Exit Sub
    If UCase(Cells(Target.Row, "D")) = "B" Then
        Cells(Target.Row, "J") = Cells(Target.Row, "H") * Cells(Target.Row, "I")
        Cells(Target.Row, "K").ClearContents
    ElseIf UCase(Cells(Target.Row, "D")) = "A" Then
        Cells(Target.Row, "K") = Cells(Target.Row, "H") * Cells(Target.Row, "I")
        Cells(Target.Row, "J").ClearContents
    Else
        MsgBox "Lütfen kayıt türü bilgisini giriniz! B/A ", vbCritical
    End If
End Sub
 
Ergün Güler' Alıntı:
Selam,
Sayın cmzrfdl,
Birinci olarak kastettiğinizi tam anlayamadım.
İkinci olarak "katkı sağlamadı" diyorsunuz.
Öncelikle şunu söyleyeyim;
1-Dosyanızı eklemelisiniz.
2-Sayfalarınızda hem fonksiyon hem de Makro kullanıyorsanız. kesinlikle çok yavaşlama olacaktır. bunu önlemek için kodlarınızın öncesi ve sonrasına aşağıdaki kodları ekleyiniz.
Kod: 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[COLOR="Red"][B]
'kodlarınız burada olsun[/B][/COLOR]

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

3-Benim bu zamana kadar öğrendiğim şudur: Excel'in yerleşik fonksiyonları ve WorksheetFunction altındaki kodlar (WorksheetFunction.Sum, WorksheetFunction.CountIf gibi) yazılan diğer kodlardan çok daha hızlıdırlar.

4- Gereğinden çok fazla kodlar yazılmış veya döngü kurulmuş olabilir.

(aynı hataları ben de çok yapmıştım. Excel'in hazır kodlarını kullanıp 50-100 ms'de sonuçlanan Makroyu 4-5 dk. ancak alabilmiştim.)

5- Bir Excel Sayfasında(2003 versiyon) en fazla satır sayısı 65.536 değil midir?
siz 800.000 satırdan bahsediyorsunuz

İyi çalışmalar.
Genişletmek için tıkla ...

Merhaba Ergün Bey,

Öncelikle vakit ayırıp sorumu yanıtladığınız için teşekkürler. Bir önceki postumda belirttiğim üzere, Excel 2007 ile çalışıyorum. Bu yüzden 800.000 satırı dahi aşabilen verilerle çalışmam gerekebiliyor. Söylediğiniz çözümü deneyeceğim. Tekrardan teşekkürler
 
Merhaba Arkadaşlar,

Verigirişi sayfasın D sütununa girdiğim veri, hesap planı sayfasında B sütununda uyuyorsa. A sütunundaki veriyi, verigirişi sayfasında K sütununa getiriyor.
Aynı şekilde

Verigirişi sayfasın G sütununa girdiğim veri, hesap planı sayfasında B sütununda uyuyorsa. A sütunundaki veriyi, verigirişi sayfasında L sütununa getiriyor.

Bu işlemi J sütununda değişiklik yaptığımda çalışacak şekilde olması için kodlarda nasıl bir düzenleme yapmalıyım.

Yardım ve fikirlerinizi bekliyorum.
 

Ekli dosyalar

Merhaba, ek dosyada bir düşeyara örneği var, makro kodunu bir türlü uyarlayamadım yardımcı olursanız çok sevinrim teşekkürler

Kod: 
=DÜŞEYARA(A:A;Sayfa1!A:B;2;0)
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod: 
Sub bul59()
Dim k As Range, i As Long, sonsat1 As Long, sonsat2 As Long
Dim sh As Worksheet, sat As Long
Set sh = Sheets("Sayfa1")
Range("B:B").ClearContents
Sheets("Sayfa2").Select
sonsat1 = Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To sonsat1
    Set k = sh.Range("A1:A" & sonsat2).Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then Cells(i, "B").Value = k.Offset(0, 1).Value
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı" & vbLf & "evrengizlen@hotmail.com", vbOKOnly
End Sub
 

Ekli dosyalar

Teşekkürler hocam, tam istediğim gibi olmuş fakat, tıklama işlevini kaldırabiliyor muyuz acaba ?

Şöyle ki, barkodları okuttuğumda, hemen karşısına düşeyara yapmasını istiyoruz.

(Veri sayfası 140-148bin satır arasında, eşleştirilecek barkod sayısı şuan için 6bin oldu devam edecek, fakat formüller dosyayı yavaşlatmaya başladı.)

Saygılar
 
Baggwell' Alıntı:
Teşekkürler hocam, tam istediğim gibi olmuş fakat, tıklama işlevini kaldırabiliyor muyuz acaba ?

Şöyle ki, barkodları okuttuğumda, hemen karşısına düşeyara yapmasını istiyoruz.

(Veri sayfası 140-148bin satır arasında, eşleştirilecek barkod sayısı şuan için 6bin oldu devam edecek, fakat formüller dosyayı yavaşlatmaya başladı.)

Saygılar
Genişletmek için tıkla ...

Dosyanız ektedir.:cool:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Dim k As Range, sonsat2 As Long
Dim sh As Worksheet, sat As Long
Set sh = Sheets("Sayfa1")
sonsat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
Target.Offset(0, 1).ClearContents
Set k = sh.Range("A1:A" & sonsat2).Find(Target.Value, , xlValues, xlWhole)
If Not k Is Nothing Then Target.Offset(0, 1).Value = k.Offset(0, 1).Value
End Sub
 

Ekli dosyalar

50 nolu mesajdaki dosyayı ve kodları değiştgirdim.
O dosya işinizi görecektir.:cool:
 
Makro ile düşeyara

Merhaba Hocam,
Bende faydalandım.
iyi çalışmalar.
 
Son düzenleme:
merhabalar,
aşagıdaki kodu b1:mn1 arasındaki tarihe ve b2:mn2 arasındaki ürünleri arayıp bulacak sekilde nasıl uyarlayabiliriz acaba.

aşagıdaki kod sadece A:A satırınına bakıyor. benim istedigim hem A:A satırına baksın hemde b1:mn1 kolonuna ve b2:mn2 kolonuna bakmasını saglamak. sumproduct formülü ile verileri getiriyorum fakat dosyayı cok kasıyor.

Kod: 
Sub bul59()
Dim k As Range, i As Long, sonsat1 As Long, sonsat2 As Long
Dim sh As Worksheet, sat As Long
Set sh = Sheets("Sayfa1")
Range("B:B").ClearContents
Sheets("Sayfa2").Select
sonsat1 = Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To sonsat1
    Set k = sh.Range("A1:A" & sonsat2).Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then Cells(i, "B").Value = k.Offset(0, 1).Value
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı" & vbLf & "evrengizlen@hotmail.com", vbOKOnly
End Sub
 
Merhaba Arkadaşlar,

Aynı durum benim içimde geçerli aşağıdaki kod ile istediğim A sutununa göre ok fakat B Sütününa göre olmadı kodda ne gibi bir değişiklik yapmamız gerekiyor.

Yardımlarınız rica ederim.

İyi çalışamalar.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Dim k As Range, sonsat2 As Long
Dim sh As Worksheet, sat As Long
Set sh = Sheets("Sayfa1")
sonsat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
Target.Offset(0, 1).ClearContents
Set k = sh.Range("A1:A" & sonsat2).Find(Target.Value, , xlValues, xlWhole)
If Not k Is Nothing Then Target.Offset(0, 1).Value = k.Offset(0, 1).Value
Target.Offset(0, 2).Value = k.Offset(0, 2).Value
Target.Offset(0, 3).Value = k.Offset(0, 3).Value
Target.Offset(0, 4).Value = k.Offset(0, 4).Value
Target.Offset(0, 5).Value = k.Offset(0, 5).Value
Target.Offset(0, 6).Value = k.Offset(0, 6).Value
Target.Offset(0, 7).Value = k.Offset(0, 7).Value
Target.Offset(0, 8).Value = k.Offset(0, 8).Value
End Sub
 
Aynı durum benim içimde geçerli aşağıdaki kod ile istediğim A sutununa göre ok fakat B Sütününa göre olmadı kodda ne gibi bir değişiklik yapmamız gerekiyor.
Genişletmek için tıkla ...

İlgili yerleri aşağıdaki kodlarla değiştirin.:cool:
Kod: 
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub

Kod: 
sonsat2 = sh.Cells(Rows.Count, "B").End(xlUp).Row

Kod: 
Set k = sh.Range("B1:B" & sonsat2).Find(Target.Value, , xlValues, xlWhole)
 
Merhaba,

Runtime Error 91: Object variable or with block variable not set"

Target.Offset(0, 2).Value = k.Offset(0, 2).Value

Hata veriyor.


İyi çalışmalar.
 
Merhaba,

sayfa1 deki verileride B ye çekersem oluyor A da ise bir önceki hatayı veriyor.


iyi çalışmalar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst