Excel Kapalı Dosyadan Karşılaştırma Yapma

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#1)  ahmttsezer » 09 Oca 2021 17:09

Herkese merhaba,

Bir konuda desteklerinize ihtiyacım var. Şimdiden herkese teşekkür ederim.

Mevcut adlı dosyada Sipariş No(C Sütunu) aynı olup Gönderi Kodu(D Sütunu) farklı olanları Karşılaştırma dosyasına getirmek istiyorum. Mükerrer sipariş ile ilgili bir çalışma yapıyorum. Kodladım fakat yeni başladığım için kod geçerli değil. Örnek dosyayı ekte iletiyorum.

Desteklerinizi rica ederim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
ahmttsezer
Yeni Başlamış
 
Kayıt: 04 Nis 2020 16:15
Meslek: Bilgisayar Öğretmeni
Yaş: 25
İleti: 40
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kocaeli / Çayırova

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#2)  halily » 09 Oca 2021 21:59

Mevcut dosyasındaki veriler mi karşılaştırma dosyasına eklenecek
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 329
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#3)  ahmttsezer » 09 Oca 2021 22:41

Halil Bey merhaba,

Evet, Mevcut adlı Excel dosyasında Sipariş No aynı olup Gönderi Kodu farklı olan kayıtların Karşılaştırma dosyasında bir sayfa oluşturularak eklenmesini istiyorum.

Teşekkürler
Kullanıcı avatarı
ahmttsezer
Yeni Başlamış
 
Kayıt: 04 Nis 2020 16:15
Meslek: Bilgisayar Öğretmeni
Yaş: 25
İleti: 40
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kocaeli / Çayırova

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#4)  halily » 09 Oca 2021 23:10

sorgu kodunu aşağıdaki şekilde düzenler misiniz?
yalnız gönderdiğiniz dosyalarda veriler 1e1 aynıydı
sonucun nasıl olması gerektiğini de gösterir misiniz
Kod: Tümünü seç
    sorgu = "SELECT [Mevcut$].F3, [Mevcut$].F4, [Mevcut$].F1, [Mevcut$].F2 " & _
            "FROM [Sayfa1$] INNER JOIN [Mevcut$] ON ([Sayfa1$].F1 = [Mevcut$].F3) AND ([Sayfa1$].F4 = [Mevcut$].F2) " & _
            "WHERE ((([Mevcut$].F4)<>[Sayfa1$]![F2]));"
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 329
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#5)  ahmttsezer » 10 Oca 2021 11:12

Halil Bey merhaba,

Öncelikle sanırım yanlış anlattım, affedersiniz.

Mevcut adlı dosyada 150-200 bin adet kayıt bulunmakta. Bu excel dosyasındaki Sipariş No(C Sütunu) değerleri aynı olan ve Gönderi Kodu(D Sütunu) farklı olan kayıtları, Karşılaştırma dosyasındaki makroyu çalıştırdığımda Karşılaştırma dosyası Sayfa1 Tarih-Proje-Sipariş No-Gönderi kodu sütunları olarak göstermek istiyorum.

Ekte güncel halini paylaşıyorum. Sonucun nasıl olması gerektiğini de Karşılaştırma excel dosyasında Sayfa1 de görebilirsiniz.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
ahmttsezer
Yeni Başlamış
 
Kayıt: 04 Nis 2020 16:15
Meslek: Bilgisayar Öğretmeni
Yaş: 25
İleti: 40
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kocaeli / Çayırova

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#6)  halily » 10 Oca 2021 13:08

Siparis no 1110 dan 3 tane var 2 tanesinin gonderimkodu 56, hangisini neye gore seçiyoruz?
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 329
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#7)  ahmttsezer » 10 Oca 2021 13:12

Halil Bey,

Sipariş No sütununda 1110 nolu siparişe ait Gönder Kodları birbirinden farklı olanları almasını istiyorum. Mesela Gönderi Kodu 2 tane 56, bir tane 57 var. 56 tekrarladığı için 1 tane alacak ve 57 değerini de alacak.
Kullanıcı avatarı
ahmttsezer
Yeni Başlamış
 
Kayıt: 04 Nis 2020 16:15
Meslek: Bilgisayar Öğretmeni
Yaş: 25
İleti: 40
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kocaeli / Çayırova

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#8)  halily » 10 Oca 2021 17:44

aşağıdaki kodu dener misiniz?
Not: referanslardan Microsoft ActiveX Data Objects x.x Library eklenmeli
Kod: Tümünü seç
Dim RS As ADODB.Recordset
Dim con As ADODB.Connection
   
    Set con = New ADODB.Connection
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & _
    "\Mevcut.xlsx;extended properties=""excel 12.0;hdr=no;imex=1"""
    Set RS = New ADODB.Recordset ' CreateObject("adodb.recordset")
    sorgu = "SELECT [F3] " & _
            "FROM " & _
            "(SELECT [F3], [F4], First([F2]) as Pr, First([F1]) as Tr " & _
            "FROM [Sayfa1$] " & _
            "GROUP BY [F3], [F4]) " & _
            "as TmpSQL " & _
            "GROUP BY [F3] " & _
            "HAVING ((Count([F4]))>1);"
   
    RS.Open sorgu, con, 3, 1
    If RS.RecordCount = 0 Then Exit Sub
    Dim EkleDizi() As Variant
    With RS
        .MoveLast
        .MoveFirst
        EkleDizi = .GetRows()
    End With
   
    For x = LBound(EkleDizi, 2) To UBound(EkleDizi, 2)
        Kyt = Kyt & ", '" & EkleDizi(0, x) & "'"
    Next x
    Kyt = Mid(Kyt, 3)
    Set RS = Nothing: sorgu = Empty
'hy_____aşama________________________________________________________2
    Set RS = New ADODB.Recordset 'CreateObject("adodb.recordset")
    sorgu = "SELECT [F3], [F4], First([F1]) AS İlkTarih, First([F2]) AS İlkProje " & _
            "FROM [Sayfa1$] " & _
            "GROUP BY [F3], [F4] " & _
            "HAVING (([F3] In (" & Kyt & "))) " & _
            "ORDER BY [F3], [F4];"
   
    RS.Open sorgu, con, 3, 1
    If RS.RecordCount = 0 Then Exit Sub
    Sheets("Sayfa1").Range("a2").CopyFromRecordset RS
    Sheets("Sayfa1").Range("a1").Value = "Sipariş Numarası"
    Sheets("Sayfa1").Range("b1").Value = "Gönderi Kodları"
    Sheets("Sayfa1").Range("c1").Value = "Tarih"
    Sheets("Sayfa1").Range("d1").Value = "Proje Adı"
    Set RS = Nothing: Set con = Nothing: sorgu = Empty
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 329
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#9)  ahmttsezer » 10 Oca 2021 19:43

Halil Bey,

Destekleriniz ve ilginiz için teşekkür ederim. Mevcut datam 540.000 satırdan oluşuyor. Normal ekteki datada çalışıyor fakat kendi datamda çalışmıyor. 10 dk dan fazla işlem sürüyor fakat sonuç vermiyor.

For x = LBound(EkleDizi, 2) To UBound(EkleDizi, 2)
Kyt = Kyt & ", '" & EkleDizi(0, x) & "'"
kodda uzun süre bekliyor.

Çok fazla satır olmasından dolayı mı çalışmıyor? Farklı bir kod yazılabilir mi?

Ek olarak Microsoft ActiveX Data Objects 6.1 Library ekledim.
Kullanıcı avatarı
ahmttsezer
Yeni Başlamış
 
Kayıt: 04 Nis 2020 16:15
Meslek: Bilgisayar Öğretmeni
Yaş: 25
İleti: 40
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kocaeli / Çayırova

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#10)  halily » 10 Oca 2021 19:51

Verileriniz ozel değilse dosyanızın ilgili kısmını ekleyebilir misiniz?
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 329
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#11)  ahmttsezer » 10 Oca 2021 21:52

Halil Bey,

Malesef şirket verileri. Uzun bir süre bekledikten sonra 'sorgu çok karmaşık' hatası verdi.
Kullanıcı avatarı
ahmttsezer
Yeni Başlamış
 
Kayıt: 04 Nis 2020 16:15
Meslek: Bilgisayar Öğretmeni
Yaş: 25
İleti: 40
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kocaeli / Çayırova

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#12)  halily » 10 Oca 2021 22:48

Dilerim işinize yarar
Kod: Tümünü seç
Dim RS As ADODB.Recordset
Dim con As ADODB.Connection
   
    Set con = New ADODB.Connection
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & _
             "\Mevcut.xlsx;extended properties=""excel 12.0;hdr=no;imex=1"""
    Set RS = New ADODB.Recordset ' CreateObject("adodb.recordset")
    sorgu = "SELECT [F3], [F4], First([F1]), First([F2]) " & _
            "FROM [Sayfa1$A2:D] " & _
            "GROUP BY [F3], [F4];"
   
    RS.Open sorgu, con, 3, 1
    If RS.RecordCount = 0 Then Exit Sub

     Sheets("Sayfa1").Range("a2").CopyFromRecordset RS

Set RS = Nothing: Set con = Nothing: sorgu = Empty

'hy_____aşama2
    Set con = New ADODB.Connection
    con.Open "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _
             ";extended properties=""excel 12.0;hdr=no"""
    Set RS = New ADODB.Recordset 'CreateObject("adodb.recordset")
    sorgu = "SELECT F1 " & _
            "FROM [Sayfa1$A2:D] " & _
            "GROUP BY F1 " & _
            "HAVING (((Count(F1))>1));"

    RS.Open sorgu, con, 3, 1
    If RS.RecordCount = 0 Then Exit Sub
    Do Until RS.EOF
        kyt = kyt & ", " & RS(0) ' & "'"
        RS.MoveNext
    Loop
   
    kyt = Mid(kyt, 3)

'hy________________Aşama3
    Set RS = New ADODB.Recordset
   
    sorgu = "SELECT F1, F2, F3, F4 " & _
            "FROM [Sayfa1$A2:D] " & _
            "WHERE (((F1) In (" & kyt & ")));"
   
    RS.Open sorgu, con, 3, 1
    If RS.RecordCount = 0 Then Exit Sub
    Sheets("Sayfa1").Cells.Clear
    Sheets("Sayfa1").Range("a2").CopyFromRecordset RS
    Sheets("Sayfa1").Range("a1").Value = "Sipariş Numarası"
    Sheets("Sayfa1").Range("b1").Value = "Gönderi Kodları"
    Sheets("Sayfa1").Range("c1").Value = "Tarih"
    Sheets("Sayfa1").Range("d1").Value = "Proje Adı"
    Set RS = Nothing: Set con = Nothing: sorgu = Empty
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 329
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#13)  ahmttsezer » 11 Oca 2021 10:10

Halil Bey merhaba,

Çok fazla zahmet verdim, kusura bakmayın.

Sipariş Numarası kısmına metinsel değerler, _1 li kayıtlar ya da *AC*, *MF* gibi değerler girilebiliyor. Sanırım metinsel ifadeler yer aldığından ekteki hatayı veriyor. Dosya ile birlikte hata kodunu içeren görseli de iletiyorum.

Tekrar zahmet verdiğim için kusura bakmayın.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
ahmttsezer
Yeni Başlamış
 
Kayıt: 04 Nis 2020 16:15
Meslek: Bilgisayar Öğretmeni
Yaş: 25
İleti: 40
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kocaeli / Çayırova

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#14)  halily » 11 Oca 2021 10:42

* karakteri joker karakterdir [b]in içinde kullanılamaz[/b]
2. olarak çalışmanızda hep sayısal veri olduğu için ben IN fonksiyonunu sayaısal olarak ayarlamıştım
metinsel ifadelerin başında ve sonunda ' tek tırnak yada "" çift çift tırnak olmalı
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 329
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#15)  halily » 11 Oca 2021 10:44

Kod: Tümünü seç
kyt = kyt & ", " & RS(0)

yerine
Kod: Tümünü seç
kyt = kyt & ", '" & RS(0)  & "'"
kullanarak dener misiniz
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 329
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#16)  ahmttsezer » 11 Oca 2021 20:15

Halil Bey merhaba,

Desteğiniz için teşekkür ederim, işe yaradı çalışıyor.

Fakat metin ile başlayan sipariş numaralarını almıyor. Kodda ne gibi bir değişiklik yapmak gerekir? Desteğinizi rica ederim.
Kullanıcı avatarı
ahmttsezer
Yeni Başlamış
 
Kayıt: 04 Nis 2020 16:15
Meslek: Bilgisayar Öğretmeni
Yaş: 25
İleti: 40
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kocaeli / Çayırova

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#17)  ahmttsezer » 11 Oca 2021 21:22

Halil Bey,

Üst mesajınızda fonksiyon ile bildiriminizi yeni gördüm. Sipariş numarası serbest formattan oluşuyor, metinsel sayısal ve birleşik noktalama işaretlerini de barındıran kayıtlar mevcut olabliyor. Fonksiyonu nasıl değiştirebiliriz. Desteklerinizi rica ederim.
Kullanıcı avatarı
ahmttsezer
Yeni Başlamış
 
Kayıt: 04 Nis 2020 16:15
Meslek: Bilgisayar Öğretmeni
Yaş: 25
İleti: 40
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kocaeli / Çayırova

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#18)  halily » 12 Oca 2021 09:19

Kod: Tümünü seç
kyt = kyt & ", """ & RS(0) & """"
sipariş no da " yoksa sorunsuz çalışması gerek.
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 329
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#19)  halily » 12 Oca 2021 10:17

aşağıdaki kodun daha hızlı çalışacağını düşünüyorum
ama deneme imkanım yok
Kod: Tümünü seç
Dim RS As ADODB.Recordset
Dim con As ADODB.Connection
   
    Set con = New ADODB.Connection
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & _
             "\Mevcut.xlsx;extended properties=""excel 12.0;hdr=no;imex=1"""
    Set RS = New ADODB.Recordset ' CreateObject("adodb.recordset")
    sorgu = "SELECT [F3], [F4], First([F1]), First([F2]) " & _
            "FROM [Sayfa1$A2:D] " & _
            "GROUP BY [F3], [F4];"
   
    RS.Open sorgu, con, 3, 1
    If RS.RecordCount = 0 Then Exit Sub

     Sheets("Sayfa1").Range("a2").CopyFromRecordset RS

Set RS = Nothing: Set con = Nothing: sorgu = Empty

'hy_____aşama2
    Dim sht As Worksheet
    Dim dict As Scripting.Dictionary
    Set dict = New Scripting.Dictionary
    Set sht = ThisWorkbook.Sheets("Sayfa1")
    SonStr = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
    For i = 2 To SonStr
        kriter = sht.Cells(i, 1)
       
        If Not dict.Exists(kriter) Then
           dict.Add kriter, 1
        Else
            dict(kriter) = dict.Item(kriter) + 1
        End If
    Next
'tekrar kontrolü
    For i = SonStr To 2 Step -1
        kriter = sht.Cells(i, 1)
        If dict(kriter) = 1 Then Rows(i).EntireRow.Delete
    Next
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 329
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Cevap: Excel Kapalı Dosyadan Karşılaştırma Yapma

İleti#20)  halily » 12 Oca 2021 10:18

pardon söylemeyi unutmuşum referanslardan Microsoft Scripting Runtime eklenmeli
Kullanıcı avatarı
halily
Siteye Alışmış
 
Kayıt: 23 May 2019 11:16
Meslek: yok
Yaş: 41
İleti: 329
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: adana

Sonraki

Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Google [Bot] ve 0 misafir

Bumerang - Yazarkafe