Makro ile düşeyara

[KARTAL133]

Merhaba Arkadaşlar

normal düşeyara yaptığım zaman excel kasıyor bazen kapanıyor bu yüzden makro ile düşeyara yapmak istiyorum yardımcı ola bilirseniz sevinirim.

İki ayrı excel dosyasından makro ile düşeyara yapmak istiyorum acnak bir türlü yapamadım yardımlarınızı rica ederim.

 

[Tevfik_Kursun]

Merhaba Arkadaş,
Örnek olsa da nasıl kastığını bir de biz görsek. DOLAYLI fonksiyonu ile çalışın, sorun olacağını sanmıyorum.
İyi çalışmalar

 

[KARTAL133]

90000 satırlık bir veri ve bu veriyi ağdan alıyor.
ayırca pivot yapınca butun excel yanıt vermiyor ve kapanıyor

 

[KARTAL133]

örnek

örnek dosya ekledim

 

[Ömer BARAN]

Merhaba.

Anladığım kadarıyla, Yaşlandırma isimli elgenin C sütunundaki veriye göre,
Vade isimli belgedeki C, E ve F sütunundaki bilgileri, Yaşlandırma belgesinin AH, AI, AJ sütunlarına getirmeyi istiyorsunuz.

Eğer isteğiniz bu ise aşağıdaki şekilde işlem yapabilirsiniz.

Formül ile DÜŞEYARA yapınca işlem ne kadar sürüyor bilemiyorum ama aşağıdaki şekilde işlem yaparak bir deneyin bakalım.

-- sadece Yaşlandırma isimli dosyanızı açın (Vade adlı dosya kapalı kalsın),
(Vade isimli belgenin Yaşlandırma isimli belgeyle aynı klasörde olması gerekiyor.)
-- alt taraftan Yaşlandırma belgesi Sayfa1'in adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- açılacak VBA ekranında sağdaki BOŞ alana aşağıdaki kod'u yapıştırın,
-- Sayfa1'de uygun bir yere bir metin kutusu veya şekil ekleyin,
-- eklediğiniz şekil kutusuna/şekile fareyle sağ tıklayıp MAKRO ATAyı seçin,
-- açılacak küçük ekranda BARAN_DUSEYARA makro adını seçerek işlemi onaylayın,

Artık, sayfaya eklediğiniz metin kutusuna/şekile fareyle tıkladığınızda kod işlem yapacaktır,
işlem tamamlanıncaya kadar bekleyin (ekrana işlemin tamamlandığını belirten uyarı gelecektir).

İşlem sonunda AH,AI,AJ sütunlarında BOŞ olan satırlardaki C sütunu verisi, Vade isimli belgedeki A sütununda YOK demektir.
.

[B][COLOR="blue"]Sub BARAN_DUSEYARA[/COLOR][/B]()
Set BRN = CreateObject("Excel.Application")
Set l = ThisWorkbook.Sheets("Liste")
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Zaman = Timer
If l.FilterMode Then l.ShowAllData
    l.[AK3] = "1": l.[AK4] = "2": l.[AK5] = "3":
    l.Range("AK3:AK5").AutoFill Destination:=Range("AK3:AK" & l.Cells(Rows.Count, 1).End(3).Row)
l.Range("A3:AK" & l.Cells(Rows.Count, 1).End(3).Row).Sort key1:=l.[C2], Order1:=1
Set kaynak = BRN.Workbooks.Open(ThisWorkbook.Path & "\Vade.xlsx")
Set yol = kaynak.Sheets("Sayfa1")
son = yol.Range("A" & Rows.Count).End(xlUp).Row
l.Range("AH3:AJ" & l.Cells(Rows.Count, 1).End(3).Row).ClearContents
On Error Resume Next
For sat = 3 To l.Cells(Rows.Count, 1).End(3).Row
    ilkk = WorksheetFunction.Match(l.Cells(sat, 3), l.[C:C], 0)
    sonn = ilkk - 1 + WorksheetFunction.CountIf(l.[C:C], l.Cells(ilkk, 3))
        l.Cells(ilkk, "AH").Value = WorksheetFunction.VLookup(l.Cells(sat, 3), yol.Range("A3:F" & son), 3, 0)
        l.Cells(ilkk, "AI").Value = WorksheetFunction.VLookup(l.Cells(sat, 3), yol.Range("A3:F" & son), 5, 0)
        l.Cells(ilkk, "AJ").Value = WorksheetFunction.VLookup(l.Cells(sat, 3), yol.Range("A3:F" & son), 6, 0)
        l.Range("AH" & ilkk & ":AJ" & ilkk).Copy l.Range("AH" & ilkk & ":AJ" & sonn)
10: If sonn = Cells(Rows.Count, 1).End(3).Row Then Exit For
    sat = sonn
Next
l.Range("A3:AK" & l.Cells(Rows.Count, 1).End(3).Row).Sort key1:=l.[AK2], Order1:=1
l.[AK:AK].ClearContents: kaynak.Close
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı. İşlem süresi; " & Format(Timer - Zaman, "0.00") & " saniye."
[B][COLOR="Blue"]End Sub[/COLOR][/B]

 

[KARTAL133]

hata

Çok teşekkürler
biraz uzun sürüyor ve hata alıyorum.

 

[Ömer BARAN]

Hata ile ilgili olarak söyleyeceğim şey, belgeler kapalı durumda iken, Görev Yönetcisini açıp, "İŞLEMLER" kulakçığındaki listede excel.exe var mı bir kontrol edin, varsa görevi sonlandırın.

Denemeden cevap yazmış değilim ve herhengi bir hata almadım.
(süre konusunda bir iddiam zaten yok, veriler değer olarak alınacağından bu süre 1 kez harcanacak ve formülden iyidir diye düşünüyorm)
Kapalı belge ile ilgili olarak ilk denememdir, umarım halledebilmişimdir diye düşündüm ama bilemiyorum.

Aslında veri yığını büyüdüğünde doğru/hızlı yöntem Scripting.Dictionary veya DİZİ şeklinde işlem yaparak
Vade sayfasındaki verilerin hafızaya alınması, Yaşlandırma begesindeki C sütunu kriterine göre de,
hafızaya alınmış verilerden C:F sütunlarındakilerin hücrelere yazılması.

Forumda özellikle Scripting.Dictionary şeklinde arama yaparsanız iyi olur.

Merak ettiğim şey; verdiğim kod'un eklediğiniz örnek belge üzerinde çalıştırıldığında hata verip vermediği.

Benim gönderdiğim kod'u çalıştırırken sadece;
-- For satırındaki başlangıç satır numarasının Yaşlandırma sayfası ilk veri satırı olduğundan ve
-- alt taraftaki kısımda da ..... yol.Range("A2:F".... kısmındaki 2 sayısının Vade belgesindeki ilk veri satırı olduğunu kontrol edin.
.

 

[Ömer BARAN]

Tekrar merhaba.

Bir de ekli belgeyi deneyin bakalım.
Biraz formül, biraz makro ile sanki daha iyi oldu.

İşlem öncesinde, VADE isimli belgenin de AÇIK OLMASINI sağlayınız.
AK2 hücresindeki AŞAĞI OK şeklindeki düğmeyi kullanın.
.

 

[Korhan Ayhan]

Alternatif;

Satır sayısı arttığında verileri döngü yerine blok olarak aktarmak hız bakımından daha faydalı oluyor.

İki dosyanızda aynı klasörde olmalıdır.

Sub Aktar()
    Application.ScreenUpdating = False
    
    Zaman = Timer
    
    Dosya = ThisWorkbook.Path & "\Vade.xlsx"
    Set K1 = Workbooks.Open(Dosya, False, False)
    
    Range("AH3:AJ" & Rows.Count).ClearContents
    Son = Cells(Rows.Count, 1).End(3).Row
    
    With Range("AH3:AH" & Son)
        .Formula = "=IFERROR(VLOOKUP(C3,[Vade.xlsx]Sayfa1!A:F,3,0),"""")"
        .Value = .Value
    End With
    
    With Range("AI3:AI" & Son)
        .Formula = "=IFERROR(VLOOKUP(C3,[Vade.xlsx]Sayfa1!A:F,4,0),"""")"
        .Value = .Value
    End With
    
    With Range("AJ3:AJ" & Son)
        .Formula = "=IFERROR(VLOOKUP(C3,[Vade.xlsx]Sayfa1!A:F,5,0),"""")"
        .Value = .Value
    End With

    K1.Close 0
    Set K1 = Nothing

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[Ömer BARAN]

Aynen Sayın AYHAN.

Ben de son belgede o yolda ilerlemiştim ama mantık olarak;
önce Vade belgesinde olmayanları devre dışı bırakayım (ilk formüllerin ve sıralama işleminin amacı oydu) ardından da sizin yaptığınız gibi vade belgesinde olanlara da formül uygulatayım şeklinde yol almıştım.

Konu sahibi 90.000 satırlık belgeden bahsedince de asıl çözümün sizin sıkça kullandığınız, Scripting.Dictionary veya DİZİ yöntemini (kaç kez baktım, denedim ama malesef bu iki olayı tam olarak anlayamadım henüz) önermiştim.
.