• DİKKAT

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

Örnek dosyadaki makroyu hızlandırmama yardımcı olur musunuz?

T

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,902
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Merhaba Arkadaşlar,
H sütununda, öğrencilerin isimlerin baş harfleri var
I, J, K, L M sütunlarında ise H sütunundaki ismin baş harflerinin ad soyad olarak ikişerli yazılışıdır
O2 ye yazılan iki harf, I, J, K, L M sütunlarında kaçıncı satırlarda olduğunu P2 den itibaren sıralarken, Q sütunundaki aynı hizaya H sütunundaki hücredekileri getirmek istiyorum.
Hazırladığım makro bu işlemi en az 25 saniyede yapıyor. Diziye alma yöntemiyle çok hızlanacağını düşünüyorum. Yardımcı olursanız sevinirim.
Saygılarımla
 

Ekli dosyalar

Aşağıdaki gibi deneyin.

Kod: 
Sub kontrol()

Dim satir As Range

[P:Q].ClearContents

metin = "*" & Left([O2], 1) & "*" & Right([O2], 1) & "*"
say = WorksheetFunction.CountIf([I:M], metin)
[S2] = "kişi": [R2] = say

Set satir = [I:M].Find(metin)
Cells(2, "P") = satir.Row
Cells(2, "Q") = satir

Do Until deg = say - 1
deg = deg + 1
Set satir = [I:M].FindNext(satir)
Cells(deg + 2, "P") = satir.Row
Cells(deg + 2, "Q") = Cells(satir.Row, "H")
Loop

End Sub
 
Son düzenleme:
Alternatif;

C++: 
Option Explicit

Sub Kontrol()
    Dim Veri As Variant, X As Long, Y As Byte, Say As Long
    Dim Aranan As Variant, Son As Long, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Range("P:S").Clear
    
    Son = Cells(Rows.Count, "H").End(3).Row
    
    Veri = Range("H1:M" & Son).Value
    
    ReDim Liste(1 To UBound(Veri, 1), 1 To 2)
    
    Aranan = UCase(Replace(Replace(Range("O2").Value, "ı", "I"), "i", "İ"))
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        For Y = 2 To UBound(Veri, 2)
            If UCase(Replace(Replace(Veri(X, Y), "ı", "I"), "i", "İ")) = Aranan Then
                Say = Say + 1
                Liste(Say, 1) = X
                Liste(Say, 2) = Veri(X, 1)
            End If
        Next
    Next
    
    If Say > 0 Then
        Range("P2").Resize(Say, 2) = Liste
        Range("R2") = Say
        Range("S2") = "Kişi"
        Columns("P:Q").AutoFit
    End If

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 
Sayın Korhan Hocam,
İlginize çok teşekkür ederim
Saygılarımla
 
Günaydın Sayın Hocalarım,
Tekrar ilgilerinize çok teşekkür ederim. Saniyenin kesri içinde bilgiler geliyor.
Ama hala Korhan Hocamın diziye alma yöntemini kavrayamadığımı anladım. İlk 7 sütunda da bilgi var, bundan, uyarlayabilirim düşüncesiyle söz etmemiştim, ama uyarlayamadım. Yaşlılık yerleşti sanırım. Kavramayı isterdim. Halbuki dizi için tavsiyelerinizi de uygulamıştım.
Levent Hocamın yöntemiyle çözdüğüm için de mutluyum.
Saygılarımla
 
Neresini kavrayamadınız. Anlatalım..
 
Sayın Korhan Hocam,
Süpersiniz, ilginize çok teşekkür ederim.
Satır numaralarını yazıktan sonra ki hücrelere A:G sütunundakileri almak istiyorum. Yapmam gereken değişikliği tarif ederseniz minnettar kalırım. Bilgiler gerçek olduğu için ortaya koyamadım.
Saygılarımla
 
Satır numaraları ve H sütunundaki bilgiyi yazdırmıştık.

Son dizilim nasıl olacak?
 
Sayın Korhan Hocam,
Şöyle bir öteleme yaptım. Arananı O2 yerine Q2 den alıyor. R sütununa satır numaralarını, devamında da A dan G sütununa kadar ne varsa sıralıyorum. Değişiklikle daha kolay kavrayabilirim diye düşünüyorum. (torunum araya girdi, o nedenle gecikti. Kusura bakmayın lütfen)
Saygılarımla
 
H sütunu sanırım iptal oldu.
 
Kavradıktan sonra eklemek kolay sayın hocam
 
Peki bu değişikliklerle kavrayabileceğinizi düşünüyor musunuz?
 
İnşallah, şiddetle umuyorum
Saygılarımla
 
İnceleyiniz.

C++: 
Option Explicit

Sub Kontrol()
    Dim Veri As Variant, X As Long, Y As Byte, Say As Long
    Dim Aranan As Variant, Son As Long, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Range("R:Y").Clear
    
    Son = Cells(Rows.Count, "A").End(3).Row
    
    Veri = Range("A1:M" & Son).Value
    
    ReDim Liste(1 To UBound(Veri, 1), 1 To 8)
    
    Aranan = UCase(Replace(Replace(Range("Q2").Value, "ı", "I"), "i", "İ"))
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        For Y = 2 To UBound(Veri, 2)
            If UCase(Replace(Replace(Veri(X, Y), "ı", "I"), "i", "İ")) = Aranan Then
                Say = Say + 1
                Liste(Say, 1) = X
                Liste(Say, 2) = Veri(X, 1)
                Liste(Say, 3) = Veri(X, 2)
                Liste(Say, 4) = Veri(X, 3)
                Liste(Say, 5) = Veri(X, 4)
                Liste(Say, 6) = Veri(X, 5)
                Liste(Say, 7) = Veri(X, 6)
                Liste(Say, 8) = Veri(X, 7)
            End If
        Next
    Next
    
    If Say > 0 Then
        Range("R2").Resize(Say, 8) = Liste
        Range("Q1") = Say
        Range("R1") = "Kişi"
        Columns("R:Z").AutoFit
    End If

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 
Sayın Korhan Hocam,
Buraya kadarını ben de yapmıştım. Bu durumda gelen sonuçlar ikişer defa geliyor. Bunun sebebini bulamamıştım, ayrıca ilk satırda S2 ye israrla isteneni getirtememiştim.
Saygılarımla
 

Ekli dosyalar

  • 2022-04-19_10-03-24.png
    2022-04-19_10-03-24.png
    4.2 KB · Görüntüleme: 3
Tevfik Bey,

Aranan veriyi çoklu sütunda arıyorsunuz.

Diyelim ki mz verisi 19. satırda hem J sütununda hem de L sütununda var. Bu durumda görmek istediğiniz sonuç ne olur?
 
Sayın Korhan Hocam,
Şimdi anladım, tamam, o zaman H sütununu aradan çıkarır tam sağa alırım, problem çözülür.
Çok teşekkür ederim.
Saygılarımla
 
Bence H sütununu aradan çıkarmayın madem öğrenmek ve anlamak istiyorsunuz kodları zorlayın. Bu haliyle H sütununu da koda eklemeye çalışın.

O zaman öğrenmiş ve anlamış olursunuz..
 
Sayın Korhan Hocam,
Tekrar, tekrar teşekkür ederim. Şahsınızda, tüm arkadaşlara, site yöneticilerine teşekkür ederim. İyi ki varsınız.
Saygılarımla
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst