• DİKKAT

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

Çözüldü Kapalı Sayfalardan Belirtilen Koşulla Göre Veri Aktarmak.

Bilemiyorum, bende bir sıkıntı olmadı.

Sorun belki kullanılan driver'ın sizin 64 bit'i desteklememesi olabilir. Dosyayı diğer dosyaların olduğu klasöre yerleştirip de açtınız değil mi?

.
 
Evet. Aynı klasör içerisinde çalıştırdım.
 
@Ziynettin Bey Merhaba;

Reportun A-B-C Sütunları boş olduğu zaman hata veriyor şimdi çözdüm. G sütunundaki saat formatını (ss:dd:nn) düzeltebilir miyiz. "
 
F sütunu tarih, G sütunu saat biçimi olarak düzenlendi.
Ne kadar sürede işleminiz gerçekleşiyor.

PHP: 
Sub bul()
Application.ScreenUpdating = False
Z = TimeValue(Now)
yol = "C:\Veri"
dosya1 = "Data.xlsx"
dosya2 = "ADM.xlsx"
dosya3 = "SDM.xlsx"

GetObject (yol & "\" & dosya1) 'Data
Set s1 = Workbooks(dosya1).Sheets("Sayfa1")
a = s1.Range("C2:O" & s1.Cells(Rows.Count, 3).End(3).Row).Value
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(a): d(a(i, 1)) = i: Next i

GetObject (yol & "\" & dosya2) 'AMD
Set s1 = Workbooks(dosya2).Sheets("Sayfa1")
a1 = s1.Range("D2:H" & s1.Cells(Rows.Count, 4).End(3).Row).Value
Set d1 = CreateObject("scripting.dictionary")
For i = 1 To UBound(a1): d1(a1(i, 1)) = a1(i, 5): Next i

GetObject (yol & "\" & dosya3) 'SMD
Set s1 = Workbooks(dosya3).Sheets("Sayfa1")
a2 = s1.Range("D2:H" & s1.Cells(Rows.Count, 4).End(3).Row).Value
Set d2 = CreateObject("scripting.dictionary")
For i = 1 To UBound(a2): d2(a2(i, 1)) = a2(i, 5): Next i


Workbooks(dosya1).Close
Workbooks(dosya2).Close
Workbooks(dosya3).Close

On Error Resume Next
Set sh = Sheets("Sayfa1")
b = sh.Range("D2:D" & sh.Cells(Rows.Count, 3).End(3).Row).Value
ReDim c(1 To UBound(b), 1 To 8)
For i = 1 To UBound(b)
    For j = 1 To 7
        c(i, j) = a(d(b(i, 1)), j + 6)
    Next j
    c(i, 8) = d1(b(i, 1))
    If c(i, 8) = "" Then
        c(i, 8) = d2(b(i, 1))
    End If
Next i

sh.[E2].Resize(UBound(b), 8) = c
sh.[F2].Resize(UBound(b)).NumberFormat = "dd.mm.yyyy"
sh.[G2].Resize(UBound(b)).NumberFormat = "hh:mm:ss"
Application.ScreenUpdating = True

MsgBox "İşlem tamam." & vbLf & vbLf & CDate(TimeValue(Now) - Z), vbInformation
End Sub
 
Ekli dosyayı klasörün içine attıktan sonra çalıştırıp test edebilirsiniz.
(64 bit Excel ile daha performanslı çalışmakta)
 

Ekli dosyalar

@Zeki Gürsoy Merhaba;
Aynı Dosyaların içerisine yüklediğiniz dosyayı indirdim ve çalıştırdım. Resimlerdeki hata ile karşılaştım.
1.JPG2.JPG
 
Sayfa1 isimli çalışma sayfasını bulamadığını söylüyor. İsimleri her dört dosyanın adını Sayfa1 olarak ayarlayın. Çalıştırmadan önce de o dört dosya kapalı olmasına dikkat edin.
 
Zeki Bey Tüm sayfaların ismi "Sayfa1" ve hepsi kapalıyken çalıştırdım. Aynı hata ile karşılaşıyorum. Göndermiş olduğunuz dosyanın adını da Report ismini verdim. Aynı hatayı verdi.
 
@Ziynettin Bey emeğinizi sağlık. Bunu da alternatif olarak kullanacağım. Kolaylıklar.
 
Zeki Bey, elinize sağlık ....

32 Bit Office 2010 ile, örnek dosyalarda işlem 6,48 saniyede tamamlandı.

Selamlar,
.
 
Teşekkürler Haluk Bey.
Gördüğünüz süre aslında örnek dosyalardaki 40-50 satırlık verilerin işlenme süresi değil. Dosyalarda CTRL + End yapıldığında çalışma alanının çok daha büyük olduğunu görebilirsiniz. Yani gerçekte işlenen kayıt sayıları (null değerler dahil) aşağıdaki gibidir:
Report.xlsx : 100.000
Data.xlsx : 100.000
ADM.xlsx : 100.000
SDM.xlsx : 100.000
 
Farkındayım Zeki Bey;

Ben de konuyla ilgili epey kafa yormuştum. Dosyalardaki "null" değerleri o zaman fark ettim ben de.

Kısıtlı SQL bilgim ve sorudan anladığım kadarıyla 35. mesajda bir şeyler yapmaya çalışmıştım. Soruyu soran arkadaş o dosyada da hata almıştı.

.
 
Haluk' Alıntı:
Zeki Bey, elinize sağlık ....

32 Bit Office 2010 ile, örnek dosyalarda işlem 6,48 saniyede tamamlandı.

Selamlar,
.
Genişletmek için tıkla ...
Haluk bey merhaba,

Zeki bey'in kodlarının çalıştığı örnek excelleri yükleyebilir misiniz.
İlk mesajdaki örnekler kaybolmuş.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst