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

[gicimi]

Merhaba;

https://yadi.sk/d/ZN_8seCk-eayPw

Açık sayfada ve Kapalı sayfalarda 100.000 adet veri bulunmaktadır.

Report sayfasına buton yardımı ile Kapalı 3 adet sayfadan belirtilen kriterlere göre verileri Report adındaki dosyaya diğer dosyalardan kontrol edip verileri aktarmak istiyorum. Report sayfasında detaylı bilgiler yer almaktadır. Konu hakkında yardımcı olabilir misiniz. Teşekkürler.

Örnek dosya: 1,95 MB.

 

[turist]

Report adındaki dosyada yer alan veriler diğer sayfalarda yok.
Örnek: D2 hücresinde görülen "8841" aslında 8840,9889428559 sayı değerine sahip.
Bu değer ise diğer sayfalarda yok.Görüntüsü "8841" olsa da Örneğin Data sayfası C47752 hücresinde "8840,57706135939" değeri var.
Diğer bütün veriler de aynı şekildedir.
Bu durumda istediğiniz verileri Report sayfasına getirmek mümkün değil.
Deneme yapmak için Report sayfasında DÜŞEYARA ile Data sayfasından bir değer bulmaya çalışın hiçbir değeri bulamayacaksınız.

Dosyalarınızı ve verilerinizi tekrar gözden geçirin.

 

[gicimi]

Sn. @turist Dosyanın MB azaltım hemde yukarıda belirtmiş olduğunuz hataları düzeltip tekrar güncelledim.

 

[Ömer BARAN]

Merhaba.

Umarım yanlış anlamadım.
Örnek belgelerinize baktığımda, Report isimli belgenizin D sütunundaki Seri No'ları 100'den başlayıp, 147'ye kadar giderken,
Data isimli belgedeki Seri No'ları 1-50 arasında, ADM belgesinde 1-49 arasında, SDK'de ise 1-64 arasında.
Bu durumda Report ile Data, ADM ve SDM belgelerindeki Seri No'larının arasında bir eşleşme mümkün görünmüyor.
.

 

[gicimi]

@Ömer BARAN Report belgesinde Seri No' ları 1-70 arası düşünebilir misiniz. Güncellemiştim fakat hatalı dosyayı eklemişim. Kusura bakmayın.

 

[Ömer BARAN]

Peki aynı seri no hem SDM ve hem de ADM dosyasında varsa, Report Sayfası K sütununa hangisindeki H sütunu değeri yazılacak?
.

 

[turist]

Sayın @gicimi
Önce "C" sürücünüzde "Deneme" isimli bir klasör oluşturun.
Eklediğim "Aylık_Rapor" klasörünü(içindeki dosyalarla birlikte) C sürücüsünde yarattığınız "Deneme" klasörünün içine atın.
Daha sonra; sadece "Report" sayfanızı açarak , butona basıp sonuçları inceleyin.
Not:
Örnek dosyanızdaki veriler uyumsuz olduğu için (test amacıyla) değişiklikler yapılmıştır.
Gerçek verilerinizle test ederken uyumluluğunu kontrol edin.
Büyük boyutlu dosyanızda, makro kodları "geç" sonuç verebilir, donma kilitlenme yapabilir.Bu durumda konuyu tekrar bildirin.

 

[Ömer BARAN]

Madem hazırladım, ben de elimdeki belgeyi göndereyim bari.
Bu belge Data, SDM ve ADM isimli belgelerle aynı klasörde olmalıdır,

Bundan önceki mesajdaki soruma cevap vermediğiniz için,
K sütununa önce ADM belgesindeki H sütunu değeri, aynı seri no SDM'de varsa bu kez aynı hücreye SDM'deki değer yazılır.

 

[gicimi]

SN. @Ömer BARAN Sn. @turist çok teşekkür ederim. Mobilden bağlanıyorum kontrol eder etmek bilgi vereceğim. Emeğinize sağlık. İyi Çalışmalar.

 

[gicimi]

@Ömer BARAN @turist gayet güzel çalışıyor. Çok teşekkür ederim.

Data sayfasına Yeni O-P-Q-R sütunlarını yeni bir veri girişi yapmak istiyorum. Report sayfasının L-M-N-O sütunlarına getirebilmek için kodda nasıl bir güncelleme yapmalıyım.

 

[Ömer BARAN]

Kod'un ilgili bölümü aşağıdaki gibi.
Kod'daki ana ibaresi Report isimli belge oluyor.

k=1 ise bakılan belge Data isimli olandır.

Mavi renklendirdiğim satırı kopyalayın ve hemen altına yapıştırın.
Örneğin, Report'da Z sütununa, Data'nın Q sütunundaki veri yazılacaksa, kopyalanan satırı aşağıdaki şekilde değiştirmek gerekir.
ana.Sheets("Sayfa1").Cells(sat, "Z") = ActiveWorkbook.ActiveSheet.Cells(satir.Row, "Q")

Başka sütunlar için de yeni satır kopyalayıp hangi sütun hangi sütuna olduğuna göre düzenlemelisiniz,
yani If... Else arasındaki herbir kod satırı bir sütun için kullanılıyor.

    If k = 1 Then kitap = "Data.xlsx": sut = "C"
    If k = 2 Then kitap = "ADM.xlsx": sut = "D"
    If k = 3 Then kitap = "SDM.xlsx": sut = "D"
    Set kapali = Workbooks.Open(ThisWorkbook.Path & "/" & kitap, , ReadOnly:=True)
        If Not kapali Is Nothing Then
        For sat = 2 To ason
            Set satir = ActiveWorkbook.ActiveSheet.Columns(sut).Find(ana.Sheets("Sayfa1").Cells(sat, "D"))
            If Not satir Is Nothing Then
                If k = 1  Then
                    ana.Sheets("Sayfa1").Cells(sat, "E") = ActiveWorkbook.ActiveSheet.Cells(satir.Row, "I")
                    ana.Sheets("Sayfa1").Cells(sat, "F") = ActiveWorkbook.ActiveSheet.Cells(satir.Row, "J")
                    ana.Sheets("Sayfa1").Cells(sat, "G") = ActiveWorkbook.ActiveSheet.Cells(satir.Row, "K")
                    ana.Sheets("Sayfa1").Cells(sat, "H") = ActiveWorkbook.ActiveSheet.Cells(satir.Row, "L")
                    ana.Sheets("Sayfa1").Cells(sat, "I") = ActiveWorkbook.ActiveSheet.Cells(satir.Row, "M")
                    ana.Sheets("Sayfa1").Cells(sat, "J") = ActiveWorkbook.ActiveSheet.Cells(satir.Row, "N")
                Else
                    ana.Sheets("Sayfa1").Cells(sat, "K") = ActiveWorkbook.ActiveSheet.Cells(satir.Row, "H")
                End If

 

[turist]

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim wb1, wb2, wb3 As Workbook
Set wb1 = Workbooks.Open(Filename:="C:\Deneme\Aylık_Rapor\Data.xlsb", ReadOnly:=True)
Set wb2 = Workbooks.Open(Filename:="C:\Deneme\Aylık_Rapor\ADM.xlsb", ReadOnly:=True)
Set wb3 = Workbooks.Open(Filename:="C:\Deneme\Aylık_Rapor\SDM.xlsb", ReadOnly:=True)
Range("E2:K" & Cells(Rows.Count, 4).End(xlUp).Row).ClearContents
For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row
For a = 2 To wb1.Sheets("Sayfa1").Cells(Rows.Count, 3).End(xlUp).Row
If Cells(i, 4).Value = wb1.Sheets("Sayfa1").Cells(a, 3) Then
Cells(i, 5) = wb1.Sheets("Sayfa1").Cells(a, 9)
Cells(i, 6) = wb1.Sheets("Sayfa1").Cells(a, 10)
Cells(i, 7) = wb1.Sheets("Sayfa1").Cells(a, 11)
Cells(i, 8) = wb1.Sheets("Sayfa1").Cells(a, 12)
Cells(i, 9) = wb1.Sheets("Sayfa1").Cells(a, 13)
Cells(i, 10) = wb1.Sheets("Sayfa1").Cells(a, 14)
Cells(i, 11) = wb1.Sheets("Sayfa1").Cells(a, 15)
Cells(i, 12) = wb1.Sheets("Sayfa1").Cells(a, 16)
Cells(i, 13) = wb1.Sheets("Sayfa1").Cells(a, 17)
End If
Next a
Next i
wb1.Close False
For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row
For a = 2 To wb2.Sheets("Sayfa1").Cells(Rows.Count, 4).End(xlUp).Row
If Cells(i, 4).Value = wb2.Sheets("Sayfa1").Cells(a, 4) Then
Cells(i, 14) = wb2.Sheets("Sayfa1").Cells(a, 8)
End If
Next a
Next i
wb2.Close False
For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row
For a = 2 To wb3.Sheets("Sayfa1").Cells(Rows.Count, 4).End(xlUp).Row
If Cells(i, 4).Value = wb3.Sheets("Sayfa1").Cells(a, 4) Then
Cells(i, 14) = wb3.Sheets("Sayfa1").Cells(a, 8)
End If
Next a
Next i
wb3.Close False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Not: ADM SDM sayfalarından alınan veriler yine en son sütuna yazılacaktır.

 

[gicimi]

@turist @Ömer BARAN çok çok teşekkür ederim. Allah razı olsun. Böyle bir vakit kazandım ki... Kolaylıklar dilerim.

 

[turist]

Sağolun sayın @gicimi
İyi çalışmalar.

 

[Ömer BARAN]

.
Kolay gelsin.
.

 

[gicimi]

@Ömer BARAN Bey Merhaba; şu anda sizin kodları 45.000 veri ile denedim. Sonucu 8 dk. gibi sürede getirebiliyor. Kodu hızlandırabilir miyiz.

 

[Haluk]

@gicimi;

Soruyu tam olarak anlayamadım.....

1) Report dosyasındaki sayfada D sütununda yer alan Seri No'lar sabit, onlara dokunmuyoruz değil mi?

2) Report dosyasındaki sayfada E-J sütunlarındaki veriyi sadece Data dosyasındaki sayfanın I-N sütunlarından olduğu gibi alıyoruz, bu verileri alırken ADM ve SDM dosyalarıyla bir işimiz yok değil mi?

3) Data dosyasından alınacak veriler 65.536 adet satırdan fazla değil, doğru mu?

4) 1 No'lu mesajınızda belirttiğiniz sorunuzun diğer kısmıyla ilgili şu anda bir fikrim yok, çünkü anlamadım. Örneğin; Report dosyasındaki sayfada 20 No'lu seri numarasına karşılık gelen değer SDM dosyasında "Önemsiz" olarak, ADM dosyasında ise yine "Önemsiz" olarak belirtilmiş. Eğer bunlardan biri "Önemsiz" diğeri "Önemli" olsaydı, Report dosyasındaki K sütununa bu verilerden hangisini, hangi kritere göre değerlendirerek alacağız?

Her neyse, 4. maddeyi şimdilik bir kenara bırakalım......... Yukarıdaki 3 soruya da cevabınız "Evet" ise, aşağıdaki kod daha hızlı olarak verileri alacaktır diye tahmin ediyorum.

Sub Test()
    'Haluk
    '26/09/2018
  
    Dim myFile As String
    Dim daoDBEngine As Object
    Dim DB As Object
    Dim RS As Object
    Dim dbRow As Long
  
    On Error Resume Next
        Set daoDBEngine = CreateObject("DAO.DBEngine")
        Set daoDBEngine = CreateObject("DAO.DBEngine.36")
        Set daoDBEngine = CreateObject("DAO.DBEngine.120")
    On Error GoTo 0
  
    myFile = ThisWorkbook.Path & Application.PathSeparator & "Data.xlsx"
  
    Range("E2:J" & Rows.Count) = ""
  
    Set DB = daoDBEngine.OpenDatabase(myFile, False, False, "Excel 8.0; HDR=No; IMEX=1;")
    Set RS = DB.OpenRecordset("Select * from [Sayfa1$I2:N65536]")
  
    With RS
        .MoveLast
         dbRow = .RecordCount
        .MoveFirst
    End With

    Range("E2").CopyFromRecordset RS
  
    MsgBox "İşlem tamam..... (Haluk)"
  
    RS.Close
    DB.Close
  
    Range("G2:G65536").NumberFormat = "hh:mm:ss"
    Set RS = Nothing
    Set DB = Nothing
    Set daoDBEngine = Nothing
End Sub

.

 

[Ömer BARAN]

Konuyu ilk sorduğunuzda konunun buraya geleceğini tahmin etmiştim aslında.
Bir şeyler yapmaya çalışırım ancak, konunun en hızlı çözümü benim pek kullanmadığım Scripting.Dictionary kullanmaktan geçiyor sanırım.
Benim yapacağım, tüm bilgileri bir sayfada toplamak, sıralamak veya belgede DÜŞEYARA uygulatmak olacak.

Ya da @Haluk Bey'in yöntemi üzerinden yürümek gerekecek.

Bu arada Sayın @Haluk Bey'e ben açıklama yazayım;
Report'daki D sütunundaki Seri No kriterine göre Data'daki C:R sütunlarında DÜŞEYARA işlemidir yapılması istenilen.
Veri alınacak/yazılacak belgeler dahil belgelerdeki veri satır sayısı 100.000 olarak ifade edildi.
-- Data isimli belgede, seri no bulunup, karşısındaki I:N aralığı Report'un E:J sütunlarına,
O:R aralığı da Report'un O:R aralığına alınacak. (O:R arasıyla ilgili istek konu sahibinin 10 numaralı cevabında eklendi)
-- Ayrıca aynı dizinde bulunan SDM ve ADM belgelerinden de aynı seri no kriterine göre ilgili belgenin H sütununun Report'un K sütununa gelmesini istiyor konu sahibi.
.

 

[Haluk]

-- Ayrıca aynı dizinde bulunan SDM ve ADM belgelerinden de aynı seri no kriterine göre ilgili belgenin H sütununun Report'un K sütununa gelmesini istiyor konu sahibi.
.

Ömer bey; demek istediğim bu zaten. Yukarıdaki mesajımda ifade ettiğim gibi SDM ve ADM dosyalarında aynı Seri No'daki Açıklama verileri
birbirinden farklıysa hangisi alınacak ve hangi kritere göre alınacak. Bu kısım belirsiz....

.

 

[Ömer BARAN]

Aynı soruyu, konuyu cevaplamadan önce, 6 numaralı cevapta ben de sormuştum ancak cevap alamadım.
Ben, hücrede sonra bakılan belgeden gelen bilgi varssa onu yazdırmıştım, yani açılan belge sırasına göre işlem yapmıştım.