• Merhaba Ziyaretçi,
    10 Ağustos'a Kadar VIP Paket %67 İNDİRİMLİ (bir kere öde, ömür boyu kullan)
    İndirimden yararlanmak için resme tıklayın. 👇🏻
  • Merhaba Ziyaretçi,
    YouTube sayfamıza abone olarak destek olabilirsiniz.
  • Sn. Ziyaretçi,
    PEAKUP E-Book & Makale & Videoları yayınlandı.

Çözüldü Hücre İçerisinde Belirtilen Koşula Göre Arama Yapma/Aktarma

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

gicimi

Yeni Üye
Katılım
18 Haz 2018
Mesajlar
63
En iyi yanıt
0
Puanları
18
Yaş
34
Konum
Ankara
Ad Soyad
Hüseyin Yılmaz
Office Versiyon
Office 2016 Pro
[BGCOLOR=rgb(254, 254, 254)]Merhaba;[/BGCOLOR]

Sayfa1' [BGCOLOR=rgb(254, 254, 254)]de yer alan[/BGCOLOR] [C][BGCOLOR=rgb(254, 254, 254)] sütununda[/BGCOLOR] 1.500 adet [BGCOLOR=rgb(254, 254, 254)]veri bulunmaktadır.[/BGCOLOR] [C][BGCOLOR=rgb(254, 254, 254)] sütununda yazılı [/BGCOLOR]6 haneli rakamlar [BGCOLOR=rgb(254, 254, 254)]yer almakta ve bu rakamları[/BGCOLOR] Sayfa2 [BGCOLOR=rgb(254, 254, 254)]nin[/BGCOLOR] [D] [BGCOLOR=rgb(254, 254, 254)]sütunun hücrelerinin içerisinde aramasını ve bulması durumunda; [/BGCOLOR][A] - ve [D] sütunundaki veriyi Sayfa3 yazdırmasını istiyorum. Konu hakkında yardımcı olabilir misiniz. Teşekkürler.

Sayfa1 C Sütunundaki hücrelerde 6 haneli rakamlarmevcuttur.
Sayfa2 D Sütununda ise 1 ile 9 hane rakamlarmevcuttur. 6 Haneli rakamlar baştan sona var ise aktarmalı


New Kriter.rar

Yaklaşık aranan satır sayısı 1.500 adet Sayfa1
Aranacak satır sayısı 50.000 - 75.000 adet Sayfa2
 

gicimi

Yeni Üye
Katılım
18 Haz 2018
Mesajlar
63
En iyi yanıt
0
Puanları
18
Yaş
34
Konum
Ankara
Ad Soyad
Hüseyin Yılmaz
Office Versiyon
Office 2016 Pro
Merhaba:

Aşağıdaki kod ile yapmak istediğim sorun çözülmüştür. İhtiyacı olabilecek arkadaşlar için paylaşıyorum.
Kod:
Option Explicit
Sub Bul_Aktar()
    Dim S1  As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Son_S1 As Long, Son_S2 As Long, Zaman As Double, Satir As Long
    Dim Veri As Variant, Aranan As Variant, X As Long, d As Object, krt
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Zaman = Timer
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Set S3 = Sheets("Sayfa3")
    
    S3.Range("A2:A" & Rows.Count).Clear
    S3.Range("C2:C" & Rows.Count).Clear
    
    Son_S2 = S2.Cells(Rows.Count, 4).End(3).Row
    
    Veri = S2.Range("A2:E" & Son_S2).Value
    Son_S1 = S1.Cells(Rows.Count, 3).End(3).Row
    Aranan = S1.Range("C2:C" & Son_S1).Value
    
    Set d = CreateObject("scripting.dictionary")
    
    For X = 1 To UBound(Aranan)
        krt = CStr(Aranan(X, 1))
        d(krt) = krt
    Next X
    
    ReDim Liste(1 To UBound(Veri), 1 To 3)
    For X = 1 To UBound(Veri)
        krt = CStr(Left(Veri(X, 4), 6))
        If d.exists(krt) Then
            Satir = Satir + 1
            Liste(Satir, 1) = Veri(X, 1)
            Liste(Satir, 1) = Veri(X, 2)
            Liste(Satir, 3) = Veri(X, 4)
        End If
    Next X

    If Satir > 0 Then
        S3.Range("A2:C" & Rows.Count).NumberFormat = "@"
        S3.Range("A2:C" & Satir + 1).Value = Liste
    End If
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - Zaman), "0.00")
End Sub
 

Murat OSMA

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,331
En iyi yanıt
11
Puanları
113
Konum
İstanbul
Web sitesi
excelarsivi.com
Ad Soyad
Murat OSMA
Office Versiyon
Office 365 TR+EN
Merhaba @gicimi,

Kısa bir not: Liste(Satir, 1) = Veri(X, 2 satırını Liste(Satir, 2) = Veri(X, 2) yaparsanız Birimini de almış olursunuz.

İlaveten, bu iki satırı neden ayrı ayrı yazdınız?
S3.Range("A2:A" & Rows.Count).Clear S3.Range("C2:C" & Rows.Count).Clear
 

gicimi

Yeni Üye
Katılım
18 Haz 2018
Mesajlar
63
En iyi yanıt
0
Puanları
18
Yaş
34
Konum
Ankara
Ad Soyad
Hüseyin Yılmaz
Office Versiyon
Office 2016 Pro
Merhaba; @Admin

B sütununda da daha sonra başka işlem yapılacağını düşünerek öyle yazılmıştı.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Üst Alt