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: 152
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, 18 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: 369
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: 152
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
Eski 21-08-2017, 22:54   #4
gicimi
Altın Üye
 
Giriş: 03/02/2008
Şehir: ankara
Mesaj: 152
Excel Vers. ve Dili:
türkçe
Varsayılan

konu hakkında yardımcı olabilir misiniz
gicimi Çevrimdışı   Alıntı Yaparak Cevapla
Eski 22-08-2017, 02:16   #5
Ömer BARAN
Uzman
 
Giriş: 08/03/2011
Şehir: ANKARA / İSTANBUL
Mesaj: 9,091
Excel Vers. ve Dili:
Office 2013 TÜRKÇE
Varsayılan

Merhaba.

Sonuç sayfası A sütununa aranacak değerin elle yazılacağı varsayılmıştır.

Bir de aşağıdaki şekilde dener misiniz?
-- Alt taraftan SONUÇ sayfasının adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranında sağdaki boş alana aşağıdaki kod'u yapıştırın,
-- Sonuç sayfası A sütununa ARANAN NUMARAyı yazın.
.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub Worksheet_Change(ByVal Target As Range)
son = Cells.SpecialCells(xlCellTypeLastCell).Row
If Intersect(Target, Range("A2:A" & son)) Is Nothing Then Exit Sub
If Target = "" Then
    Range(Cells(Target.Row, 2), Cells(Target.Row, 4)).ClearContents
    Exit Sub
End If
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set wf = Application.WorksheetFunction
If wf.CountIf(s1.[B:B], Target) > 0 Then
    s1sat = wf.Match(Target, s1.[B:B], 0)
    s1deg = s1.Cells(s1sat, "Q")
End If
If wf.CountIf(s2.[B:B], Target) > 0 Then
    s2sat = wf.Match(Target, Sheets("Sayfa2").[B:B], 0)
    s2deg = s2.Cells(s2sat, "Q")
End If

If s1deg > 0 Or s2deg > 0 Then
    minn = wf.Min(s1deg, s2deg)
        If minn = s1deg And s1deg < 100 Then
            sat = s1satt
            tarih = s1.Cells(s1sat, "G")
            saat = s1.Cells(s1sat, "H")
            Cells(Target.Row, 2) = tarih
            Cells(Target.Row, 3) = Format(saat, "hh:mm:nn")
            Cells(Target.Row, 4) = s1.Cells(s1sat, "Q")
            Exit Sub
        Else
            Cells(Target.Row, 2).ClearContents
            Cells(Target.Row, 3).ClearContents
        End If
        
        If minn = s2deg And s2deg < 100 Then
            sat = s2satt
            tarih = s2.Cells(s2sat, "G")
            saat = s2.Cells(s2sat, "H")
            Cells(Target.Row, 2) = tarih
            Cells(Target.Row, 3) = Format(saat, "hh:mm:nn")
            Cells(Target.Row, 4) = s2.Cells(s1sat, "Q")
        Else
            Cells(Target.Row, 2).ClearContents
            Cells(Target.Row, 3).ClearContents
            Exit Sub
        End If
End If
s1sat = Empty: s2sat = Empty: s1deg = Empty: s2deg = Empty: tarih = Empty: saat = Empty
End Sub
__________________
.
☾✭ İnadına TÜRKÇE ✭☽

-- Sorunuzu, gerçek belgenizle aynı yapıda ve olması gereken sonuçların elle yazıldığı örnek belge ile destekleyiniz.
-- ALTIN ÜYELİK öneriyorum. / FORUM KURALLARInı mutlaka okuyunuz.
-- ALTIN ÜYE olmayanlar, örnek belgeyi dosya.tc, dosya.co gibi bir siteye yükleyip, belgeye erişim adresini verebilir.
-- Özel mesaj ile soru sormayınız. / Geri bildirimde bulunulmayan cevaplarımı siliyorum.
Ömer BARAN Çevrimdışı   Alıntı Yaparak Cevapla
Eski 27-08-2017, 22:17   #6
gicimi
Altın Üye
 
Giriş: 03/02/2008
Şehir: ankara
Mesaj: 152
Excel Vers. ve Dili:
türkçe
Varsayılan

Ömer Bey Merhaba,
Aram sayfasına El ile yazmıyorum. A sütununda numara sayısı 10.000 üzeri ve iki sayfa arasında aranan değerleri değiştirdiğimde veriyi güncellemiyor.
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 08:24


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

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- 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 Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden