• DİKKAT

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

Makro İle En Son Kaydı Bulmak

E

Ergün Güler

Katılım
5 Ocak 2009
Mesajlar
1,586
Excel Vers. ve Dili
2003 Türkçe
Selam,
Örnek dosyam ektedir. Açıklama "Sayaç Sorgulama" sayfasındadır. Kısaca izah edeyim.
Ben "Yapılan Bakımlar" sayfasında aradığım koşula uyan en son satırı bulmak ve bu satıra ait istediğim veriyi "Sayaç Sorgulama" sayfına yazmak istiyorum.
Mesela,
"Sayaç Sorgulama" sayfasındaki MTS-1 ve 200 'e (A9 ve B9) eşit olan "Yapılan Bakımlar" sayfasında aradığımızda birçok satır var. Ancak, bu koşula uyan en son satır 27.satırdır.

şimdiden yardımlarınız için çok teşekkür ederim.
İyi çalışmalar.
 

Ekli dosyalar

Aşağıdaki makro kodunu dosyanıza koyun, dosyanızı saklayın ve çalıştırın, makro bulguları E ve F kolonlarına yazılacaktır; doğru olduğundan emin olduğunuzda yazılacak kolonları c ve d olarak değiştirin. Kolay gelsin..

Sub son_kyt()
sh1 = "Sayaç Sorgulama"
sh2 = "Yapılan Bakımlar"

Sheets(sh1).Select
Cells(1, 1).Select
son1 = Selection.End(xlDown).Row
For r = 2 To son1
degA = Cells(r, "a")
degB = Cells(r, "b")
GoSub son_bul

Next r
End
son_bul:
Sheets(sh2).Select
Cells(1, 1).Select
son2 = Selection.End(xlDown).Row
For r2 = 2 To son2
If Cells(r2, "b") = degA And Cells(r2, "d") = degB Then
de2A = Cells(r2, "A")
de2E = Cells(r2, "E")
End If
Next r2
Sheets(sh1).Select
Cells(r, "E") = de2A ' E kolonuna yazılıyor doğru ise E yerine C yapılacak
Cells(r, "F") = de2E ' F kolonuna yazılıyor doğru ise F yerine D yapılacak
de2A = " " 'sıfırlansın
de2E = " " 'sıfırlansın
Return
End Sub
 
Syn. Ergün Güler;
Dosyanız ekte.
Kod: 
UserForm1.Show
  UserForm1.Label1.ForeColor = &HC0&
  UserForm1.Height = 25
  
Set s1 = Sheets("Sayaç Sorgulama")
Set s2 = Sheets("Yapılan Bakımlar")
For sat1 = 2 To s2.Cells(65536, "B").End(xlUp).Row
For sat2 = 2 To s2.Cells(65536, "D").End(xlUp).Row

If s1.Cells(sat1, 1) = s2.Cells(sat2, 2) Then
If s1.Cells(sat1, 2) = s2.Cells(sat2, 4) Then

s1.Cells(sat1, 4) = s2.Cells(sat2, 5)
s1.Cells(sat1, 3) = s2.Cells(sat2, 1)

End If
End If
Next sat2
Next sat1

UserForm1.Label1.Caption = "Sayaç sorgulama güncellendi.!!!"
  UserForm1.Label1.ForeColor = &H8000&
  UserForm1.Height = 110
  
End Sub

"SAYAÇ SORGOLAMA" SAYFASI HER AÇILDIĞINDA GÜNCELLEME YAPAR.

ASIL DOSYANIZDA "YAPILAN BAKIMLAR" SAYFASI ÇOK UZUN İSE GÜNCELLEME İŞLEMİ 5 - 10 SANİYE SÜRER _
BU SÜRENİN TAMAMLANDIĞINI GÖSTEREN UYARI MESAJI GÖRMEK İSİYORSANIZ KODUN BAŞINDAKİ VE KODUN SONONDAKİ _
YEŞİL SATIRLARI ÇALIŞIR DURUMA GETİRİN.( Başlarındaki ' işaretini kaldırarak )
 

Ekli dosyalar

Son düzenleme:
Selam sayın ynmcany, ve Sayın nsertoglu
Çözümleriniz için çok teşekkür ederim. Asıl dosyama uyarladım.
Her ikinizin kodlarının baş ve sonlarına
Kod: 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
getirmeme rağmen, bayağı uzun sürüyor. Sayın ynmcany'ın kodları daha hızlı çalışıyor.
Ben daha önceden fonksiyonlar ile yapıyordum. Şimdi yavaş yavaş Makroya geçiyorum.
Çözümleriniz çok güzel ancak, WorksheetFunction.Find, Range.Find, WorksheetFunction.Lookup, WorksheetFunction.Search v.b. yerleşik excel fonksiyon kodları ile daha hızlı alternatif çözümler bulabilir miyiz?

Yardımlarınız ve ilginiz için çok teşekkür ederim.
İyi çalışmalar.
 
Alternatif olarak Yapılan Bakımlar sayfasında F sutünunu yardımcı olarak kullandım. dosyanızı kontrol ediniz.


Kod: 
Sub aranan_en_son_deger()
Set Sh1 = Sheets("Yapılan Bakımlar")
Set Sh2 = Sheets("Sayaç Sorgulama")
Dim aranan As String
Dim Rng As Range
For i = 2 To Sh2.Cells(Rows.Count, "B").End(3).Row
aranan = Sh2.Cells(i, 1).Value & Sh2.Cells(i, 2).Value
With Sh1.Range("f:f")
Set Rng = .Find(What:=aranan, After:=.Cells(1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
Sh2.Cells(i, 3).Value = Sh1.Cells(Rng.Row, 1)
Sh2.Cells(i, 4).Value = Sh1.Cells(Rng.Row, 5)
End With
Next
MsgBox "işlem tamam"
End Sub
 

Ekli dosyalar

halit3' Alıntı:
Alternatif olarak Yapılan Bakımlar sayfasında F sutünunu yardımcı olarak kullandım. dosyanızı kontrol ediniz.


Kod: 
Sub aranan_en_son_deger()
Set Sh1 = Sheets("Yapılan Bakımlar")
Set Sh2 = Sheets("Sayaç Sorgulama")
Dim aranan As String
Dim Rng As Range
For i = 2 To Sh2.Cells(Rows.Count, "B").End(3).Row
aranan = Sh2.Cells(i, 1).Value & Sh2.Cells(i, 2).Value
With Sh1.Range("f:f")
Set Rng = .Find(What:=aranan, After:=.Cells(1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
Sh2.Cells(i, 3).Value = Sh1.Cells(Rng.Row, 1)
Sh2.Cells(i, 4).Value = Sh1.Cells(Rng.Row, 5)
End With
Next
MsgBox "işlem tamam"
End Sub
Genişletmek için tıkla ...

Selam Sayın Halit3 hocam,
Ellerinize sağlık, Asıl dosyama uyarladım, çok hızlı çalışıyor. H sütununda birleştirme yapmışsınız. Find komutunda bitişik olmayan 2 Range içinde arama yapılamadığından mı?
bir çok yerde Find komutunu kullanmak istiyorum, ancak bazı özelliklerinin hakkını veremiyorum. Mesela kodlarda kullandığınız
Kod: 
Set Rng = .Find(What:=aranan, After:=.Cells(1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
bu Find komutundan biraz bahseder misiniz? son arananı hangi özelliği buluyor? mümkünse farklı kullanım özelliklerinden bahseder misiniz?
şimdiden çok teşekkür ederim. İyi çalışmalar.
 
Selamlar,

Ergün bey alternatif olarak aşağıdaki kodu da kullanabilirsiniz.

Kod: 
Option Explicit
 
Sub SAYAÇ_SORGULA()
    Dim X As Long, SATIR As Long, SON As Long, FORMÜL As String
    
    SON = Sheets("Yapılan Bakımlar").Range("A65536").End(3).Row
    
    Sheets("Sayaç Sorgulama").Select
    
    For X = 2 To Range("A65536").End(3).Row
        FORMÜL = Replace("=SUMPRODUCT(MAX(('Yapılan Bakımlar'!B2:B65536=""" & Cells(X, "A") & """)*('Yapılan Bakımlar'!D2:D65536=" & Cells(X, "B") & ")*ROW(2:65536)))", "65536", SON)
        SATIR = Evaluate(FORMÜL)
        Cells(X, "C") = Sheets("Yapılan Bakımlar").Cells(SATIR, "A")
        Cells(X, "D") = Sheets("Yapılan Bakımlar").Cells(SATIR, "E")
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
Selamlar,

Ergün bey alternatif olarak aşağıdaki kodu da kullanabilirsiniz.
QUOTE]

Selam,
Sayın Hocam,
Çok teşekkür ederim. Çok iyi ve çok hızlı Sayın Halit Hocamın kodları ile hemen hemen aynı hızdalar. Gerçekten hepinize çok teşekkür ederim.
Hangi birini kullancağıma şaşırdım.
Bir soruda bu kadar alternatif ve birbirinden güzel çözümler bulmak beni çok mutlu etti. Bu zamana kadar siteden bazı şeyler öğrendikten sonra geri kalanını hep kendim halletmeye çalıştım. çoğu kodlarımda da döngü ve WorksheetFuntion özelliklerini kullandım. Bilseydim, her kafama takılanı sorar, hep alternatif şeyler öğrenir, hem de dosylarımı daha hızlı ve pratik olmasını sağlardım.
Kodlardaki Replace komutunu anlayamadım. Biraz izah edebilir misiniz?

Kodlardaki formülü aşağıdaki gibi örneklendirdim.
Kod: 
=TOPLA.ÇARPIM(MAK(('Yapılan Bakımlar'!B2:B745="[COLOR="Blue"]AU2-MNK-1[/COLOR]")*('Yapılan Bakımlar'!D2:D745=[COLOR="blue"]50[/COLOR])*SATIR(2:745)))
Mavi olanları B ve D sütunlarındaki en son satır no.sunu buluyor. Ancak, nasıl buluyor? vallahi anlayamadım. İzah edebilirseniz çok sevinirim.

Şimdiden çok teşekkür ederim. İyi çalışmalar.
Genişletmek için tıkla ...
 
Selamlar,

Ergün bey kısaca açıklamaya çalışayım.

Ben Topla.Çarpım fonksiyonunu 65536 satırı kapsayacak şekilde hazırladım. Tabi bu kadar satırı her seferinde hesaplamak kodu yavaşlatacaktır. Çünkü Topla.Çarpım fonksiyonu yapısı itibariyle yavaş çalışan bir fonksiyondur.

Bu sebeple "SON" değişkenine dolu satır sayısını atadıktan sonra Topla.Çarpım içinde geçen 65536 değerlerini "Replace" komutu ile değiştirerek bir nevi dinamik alan oluşturmak istedim. Bu şekilde kod her zaman dolu satır sayısı kadar işlem yapacaktır. Burada şu sonucu çıkarabilirsiniz. Tablonuzdaki dolu satır sayınız çoğaldıkça kod biraz daha yavaş çalışacaktır.

Son satır numarasını aslında "Maksimum" fonksiyonu buluyor. Tabiki tek başına bu formülle sonuca gitmemiz için DİZİ formül kullanmak gerekir. Topla.Çarpım fonksiyonu dizi mantığı ile çalıştığından "Maksimum" fonksiyonu beraber kullanarak sonuca gittim.

Formül şu mantıkla çalışmaktadır;

"Yapılan Bakımlar" sayfasının "B" ve "D" sütunlarındaki değerleri kontrol edip uyan verinin satır numarasını vermektedir.

Formülü çözümlediğimizde kısaca aşağıdaki gibi bir dizi oluşmaktadır.

"0/0/0/8/0/0/0/20/0/0/0/0/0/32/0/0/0/0/0"

Bu aşamadan sonra Maksimum fonksiyonu devreye girerek çözümlemedeki 32 değerini döndürerek sonuca gitmektedir.

Umarım açıklamalar sizin için faydalı olur.
 
Ergün Güler' Alıntı:
Selam Sayın Halit3 hocam,
Ellerinize sağlık, Asıl dosyama uyarladım, çok hızlı çalışıyor. H sütununda birleştirme yapmışsınız. Find komutunda bitişik olmayan 2 Range içinde arama yapılamadığından mı?
bir çok yerde Find komutunu kullanmak istiyorum, ancak bazı özelliklerinin hakkını veremiyorum. Mesela kodlarda kullandığınız
Kod: 
Set Rng = .Find(What:=aranan, After:=.Cells(1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
bu Find komutundan biraz bahseder misiniz? son arananı hangi özelliği buluyor? mümkünse farklı kullanım özelliklerinden bahseder misiniz?
şimdiden çok teşekkür ederim. İyi çalışmalar.
Genişletmek için tıkla ...

Kod: 
Set Rng = .Find(What:=aranan, After:=.[COLOR=red]Cells(1),[/COLOR] LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)

burada kırmızı yazan yerde 1 rakamı en son aradığın değeri veriyor eğer onu 3 yaparsan aranan ilk değeri verecektir.

Bununla ilgili aşağıdaki linki irdeleyiniz.


http://www.excel.web.tr/f60/end-komutu-t55758.html
 
Korhan Ayhan' Alıntı:
Selamlar,

Ergün bey kısaca açıklamaya çalışayım.
Formülü çözümlediğimizde kısaca aşağıdaki gibi bir dizi oluşmaktadır.

"0/0/0/8/0/0/0/20/0/0/0/0/0/32/0/0/0/0/0"

Bu aşamadan sonra Maksimum fonksiyonu devreye girerek çözümlemedeki 32 değerini döndürerek sonuca gitmektedir.

Umarım açıklamalar sizin için faydalı olur.
Genişletmek için tıkla ...
Selam,
Sayın Hocam,
Açıklamalarınız ve yardımlarınız için çok teşekkür ederim. Çok faydası oldu.

Replace yerine şöyle birşey yaptım;

Kod: 
[B]65536[/B] yerine [B]" & SON & "[/B]

aynı hızda sonuç verdi.

Çok teşekkür ederim.
İyi çalışmalar.
 
halit3' Alıntı:
Kod: 
Set Rng = .Find(What:=aranan, After:=.[COLOR=red]Cells(1),[/COLOR] LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)

burada kırmızı yazan yerde 1 rakamı en son aradığın değeri veriyor eğer onu 3 yaparsan aranan ilk değeri verecektir.

Bununla ilgili aşağıdaki linki irdeleyiniz.


http://www.excel.web.tr/f60/end-komutu-t55758.html
Genişletmek için tıkla ...

Selam Sayın Halit3 hocam,
Açıklamalarınız ve yardımlarınız için çok teşekkür ederim.
Ancak verdiğiniz linkte End komutu hakkında. Find Komutu hakkında birşey yok sanırım.
İyi çalışmalar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst