Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Excel'e Yeni Başlayanlar
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Excel'e Yeni Başlayanlar Excel kullanmaya yeni başladıysanız sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 30-07-2017, 22:24   #1
gicimi
Altın Üye
 
Giriş: 03/02/2008
Şehir: ankara
Mesaj: 143
Excel Vers. ve Dili:
türkçe
Varsayılan Formül Yada Makro İle Sayfalar Arası Arama ve Yazdırma

MErhaba,

Ekteki örnekte sayfa1 ve sayfa2 de veriler bulunmaktadır.

Her iki sayfadaki aranacak veriler farklı tarihlerde de yer almaktadır.

Sonuç sayfasına aranan numarayı yazdığımda sayfa1-sayfa2 de yer alan uzaklık sutunda <100 küçük ise en küçük veriyi getirmesini istiyorum.

Sayfalardaki veriler 80.000 üzeridir.

Yardımlarınızı bekliyorum.
Eklenmiş Dosyalar
Dosya Türü: xlsx Örnek.xlsx (14.0 KB, 11 Görüntülenme)
gicimi Çevrimdışı   Alıntı Yaparak Cevapla
Eski 31-07-2017, 00:12   #2
Ziynettin
Altın Üye
 
Giriş: 17/04/2008
Şehir: istanbul
Mesaj: 351
Excel Vers. ve Dili:
office2010
Varsayılan

Merhaba,

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Option Explicit
Sub aktar()
Dim a(), b(), i As Long, Say As Long
Dim snc As Worksheet, sh As Variant
Dim z: z = TimeValue(Now)
Set snc = Sheets("Sonuç")
Dim aranan_no: aranan_no = CStr(snc.[A2])
If aranan_no = "" Then MsgBox "A2 hücresine numara giriniz.", vbCritical: Exit Sub
Dim s1: Set s1 = Sheets("sayfa1")
Dim s2: Set s2 = Sheets("sayfa2")
Dim son1: son1 = s1.Cells(Rows.Count, 2).End(3).Row
Dim son2: son2 = s2.Cells(Rows.Count, 2).End(3).Row
ReDim b(1 To son1 + son2, 1 To 4)
    For Each sh In Array("Sayfa1", "Sayfa2")
        a = Sheets(sh).Range("B2:Q" & Sheets(sh).Cells(Rows.Count, 2).End(3).Row).Value
        For i = 1 To UBound(a)
            If a(i, 16) < 100 And CStr(a(i, 1)) = aranan_no Then
                Say = Say + 1
                b(Say, 1) = a(i, 1)
                b(Say, 2) = a(i, 6)
                b(Say, 3) = a(i, 7)
                b(Say, 4) = a(i, 16)
            End If
        Next i
        If Say > 0 Then
            snc.Range("A2:D" & Rows.Count).ClearContents
            snc.[A2].Resize(Say, 4) = b
            snc.[B2].Resize(Say).NumberFormat = "dd.mm.yyyy"
            snc.[C2].Resize(Say).NumberFormat = "hh:mm:ss"
            snc.[D2].Resize(Say).NumberFormat = "#,##0.00"
        End If
    Next sh
MsgBox "işlem tamam." & vbLf & "İşlem süreniz:  " & CDate(TimeValue(Now) - z), vbInformation
End Sub
Ziynettin Çevrimdışı   Alıntı Yaparak Cevapla
Eski 12-08-2017, 18:36   #3
gicimi
Altın Üye
 
Giriş: 03/02/2008
Şehir: ankara
Mesaj: 143
Excel Vers. ve Dili:
türkçe
Varsayılan

Alıntı:
Ziynettin tarafından gönderildi Mesajı Görüntüle
Merhaba,

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Option Explicit
Sub aktar()
Dim a(), b(), i As Long, Say As Long
Dim snc As Worksheet, sh As Variant
Dim z: z = TimeValue(Now)
Set snc = Sheets("Sonuç")
Dim aranan_no: aranan_no = CStr(snc.[A2])
If aranan_no = "" Then MsgBox "A2 hücresine numara giriniz.", vbCritical: Exit Sub
Dim s1: Set s1 = Sheets("sayfa1")
Dim s2: Set s2 = Sheets("sayfa2")
Dim son1: son1 = s1.Cells(Rows.Count, 2).End(3).Row
Dim son2: son2 = s2.Cells(Rows.Count, 2).End(3).Row
ReDim b(1 To son1 + son2, 1 To 4)
    For Each sh In Array("Sayfa1", "Sayfa2")
        a = Sheets(sh).Range("B2:Q" & Sheets(sh).Cells(Rows.Count, 2).End(3).Row).Value
        For i = 1 To UBound(a)
            If a(i, 16) < 100 And CStr(a(i, 1)) = aranan_no Then
                Say = Say + 1
                b(Say, 1) = a(i, 1)
                b(Say, 2) = a(i, 6)
                b(Say, 3) = a(i, 7)
                b(Say, 4) = a(i, 16)
            End If
        Next i
        If Say > 0 Then
            snc.Range("A2:D" & Rows.Count).ClearContents
            snc.[A2].Resize(Say, 4) = b
            snc.[B2].Resize(Say).NumberFormat = "dd.mm.yyyy"
            snc.[C2].Resize(Say).NumberFormat = "hh:mm:ss"
            snc.[D2].Resize(Say).NumberFormat = "#,##0.00"
        End If
    Next sh
MsgBox "işlem tamam." & vbLf & "İşlem süreniz:  " & CDate(TimeValue(Now) - z), vbInformation
End Sub
Merhaba,

işlem tamamlandı uyarı veriyor ancak Sonuç kodu A sutuna numara girdiğimde veriyi getirmiyor. Kontrol edebilir misiniz.
gicimi Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 13:44


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Hurda - Torna - Çorlu Web Tasarım - Tarot Falı - Fenerbahçe Haberleri - Trakya Haberleri - investing - Hurda - Kozmetik Ürünler - Excel Eğitimi - Lingerie - Dyeing Machine - Çorlu Temizlik- Hazır Site- SEO- Çorlu Burun Estetiği- Karton Bardak- Çorlu Pimapenci- İstanbul Avukat- Çorlu Kekemelik- Edirne Su Arıtma- Çorlu Perde Yıkama- Marmara Ereğlisi Hotel- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Kamera- Çorlu Fiber- Çorlu Araç Takip-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden