Veri Birleştirme

[Suddedly]

Selamun aleykum arkadaşlar hayırlı işler. Ekteki dosyamda birinci sayfada fasondan gelen ürünlerin ölçü ölçü ve palet palet miktarları ve m2 leri bulunmaktadır diğer bilgileri ile birlikte. İkinci sayfada ise bunların irsaliyedeki adedinin ölçü ölçü toplamı görünmektedir örnek olarak. Ben ilk sayfadaki gibi verileri giriyorum. Ancak Fatura kontrolümde ilk sayfadan çekeceğim liste çok uzun olacağı için (fatura da 43x63 - 1500 m2 gibi toplu kesiliyor) ikinci sayfadaki gibi irsaliyedeki ölçülerin toplamlarının görünmesini sağlamak. Örnek olarak ilk sayfadaki bir ölçüyü ve ikinci sayfadaki görünmesi gereken karşılığını sarıyla gösterdim. Yardımlarınız için şimdiden teşekkür ederim.







http://s8.dosya.tc/server5/2kvdc4/fasonfaturakontrol.xlsx.html

 

[Emir Hüseyin Çoban]

.

Makro kodları ile daha kolay sonuç alınabilir. Sizin için uygun olur mu?

.

 

[altan888]

Merhaba

Merhaba, tablonuzu anladığım kadarı ile yapmaya çalıştım ancak sizin tablonuzla benim tablomu yan yana koyduğumda net m2 toplamlarında fark çıktı anlamadım, gri alanlar formüllü alanlar müdahale etmeden sütunları gizlerseniz tabloyu kullanabilirsiniz, iyi çalışmalar

 

[Suddedly]

.

Makro kodları ile daha kolay sonuç alınabilir. Sizin için uygun olur mu?

.

Sayın Emir günaydınlar. Makro ile de olabilir tabii daha kısa ve exceli yormadan nasıl yapabilinecekse o olabilir.

Sayın altan888 altın üye olmadığım için dosyanızı göremiyorum. Teşekkür ederim

 

[Emir Hüseyin Çoban]

.

Sub kod()

    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .EnableEvents = False
    End With

    Dim SD As Worksheet: Set SD = Sheets("ÇITIŞLI TRV 2016")
    Dim SO As Worksheet: Set SO = Sheets("Sayfa6")

    Dim dic As Object, liste(), dizi()

    son = SD.Cells(Rows.Count, "B").End(3).Row
    liste = SD.Range("A8:I" & son).Value

    ReDim dizi(1 To son, 1 To 9)

    Set dic = CreateObject("scripting.dictionary")

    For x = 1 To UBound(liste, 1)

        aranan = liste(x, 2) & "#" & liste(x, 3) & "#" & liste(x, 4)

        If Not dic.exists(aranan) Then
            n = n + 1
            dic.Add aranan, n
            ReDim Preserve dizi(1 To son, 1 To 9)
            dizi(n, 1) = liste(x, 1)
            dizi(n, 2) = liste(x, 2)
            dizi(n, 3) = liste(x, 3)
            dizi(n, 4) = liste(x, 4)
        End If

        dizi(dic.Item(aranan), 5) = dizi(dic.Item(aranan), 5) + liste(x, 5)
        dizi(dic.Item(aranan), 6) = dizi(dic.Item(aranan), 6) + liste(x, 6)
        dizi(dic.Item(aranan), 7) = dizi(dic.Item(aranan), 7) + liste(x, 7)

    Next x

    SO.Range("A2:G" & Rows.Count).ClearContents
    SO.Range("A2").Resize(dic.Count, 7) = dizi

    With Application
        .ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .EnableEvents = True
    End With
    MsgBox "B i t t i"
End Sub

.

 

[Suddedly]

Şunu eklemesini unutmuşum benim fatura kontrolü için ikinci sayfada 22277 ile 22288 nolu irsaliye bilgilerini getir demem gerekiyor. Buradaki örnekte birkaç irsaliye girişi var. Orjinalinde binlerce kayıt var.

 

[Suddedly]

Hocam bu koda bir irsaliye aralığı sorgusu ekleyebilir miyiz? Çünkü daha önce de belirttiğim gibi binlerce satır olacak ve arasından ancak şu irsaliye ile şu irsaliye arasındaki girişleri listele diyerek kontrol sağlanabilir.

.

Sub kod()

    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .EnableEvents = False
    End With

    Dim SD As Worksheet: Set SD = Sheets("ÇITIŞLI TRV 2016")
    Dim SO As Worksheet: Set SO = Sheets("Sayfa6")

    Dim dic As Object, liste(), dizi()

    son = SD.Cells(Rows.Count, "B").End(3).Row
    liste = SD.Range("A8:I" & son).Value

    ReDim dizi(1 To son, 1 To 9)

    Set dic = CreateObject("scripting.dictionary")

    For x = 1 To UBound(liste, 1)

        aranan = liste(x, 2) & "#" & liste(x, 3) & "#" & liste(x, 4)

        If Not dic.exists(aranan) Then
            n = n + 1
            dic.Add aranan, n
            ReDim Preserve dizi(1 To son, 1 To 9)
            dizi(n, 1) = liste(x, 1)
            dizi(n, 2) = liste(x, 2)
            dizi(n, 3) = liste(x, 3)
            dizi(n, 4) = liste(x, 4)
        End If

        dizi(dic.Item(aranan), 5) = dizi(dic.Item(aranan), 5) + liste(x, 5)
        dizi(dic.Item(aranan), 6) = dizi(dic.Item(aranan), 6) + liste(x, 6)
        dizi(dic.Item(aranan), 7) = dizi(dic.Item(aranan), 7) + liste(x, 7)

    Next x

    SO.Range("A2:G" & Rows.Count).ClearContents
    SO.Range("A2").Resize(dic.Count, 7) = dizi

    With Application
        .ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .EnableEvents = True
    End With
    MsgBox "B i t t i"
End Sub

.

 

[Emir Hüseyin Çoban]

.


Başlangıç İrsaliye No Hücresi: I1
Bitiş İrsaliye No Hücresi: J1 olduğunu varsayarsak..

Sub kod()

    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .EnableEvents = False
    End With

    Dim SD As Worksheet: Set SD = Sheets("ÇITIŞLI TRV 2016")
    Dim SO As Worksheet: Set SO = Sheets("Sayfa6")

    Dim dic As Object, liste(), dizi()

    son = SD.Cells(Rows.Count, "B").End(3).Row
    liste = SD.Range("A8:I" & son).Value

    ReDim dizi(1 To son, 1 To 9)

    Set dic = CreateObject("scripting.dictionary")

    For x = 1 To UBound(liste, 1)
[B][COLOR="DarkRed"]
        If liste(x, 2) >= SO.Range("I1") And liste(x, 2) <= SO.Range("J1") Then[/COLOR][/B]

            aranan = liste(x, 2) & "#" & liste(x, 3) & "#" & liste(x, 4)

            If Not dic.exists(aranan) Then
                n = n + 1
                dic.Add aranan, n
                ReDim Preserve dizi(1 To son, 1 To 9)
                dizi(n, 1) = liste(x, 1)
                dizi(n, 2) = liste(x, 2)
                dizi(n, 3) = liste(x, 3)
                dizi(n, 4) = liste(x, 4)
            End If

            dizi(dic.Item(aranan), 5) = dizi(dic.Item(aranan), 5) + liste(x, 5)
            dizi(dic.Item(aranan), 6) = dizi(dic.Item(aranan), 6) + liste(x, 6)
            dizi(dic.Item(aranan), 7) = dizi(dic.Item(aranan), 7) + liste(x, 7)
[B][COLOR="darkred"]        End If[/COLOR][/B]
    Next x

    SO.Range("A2:G" & Rows.Count).ClearContents
    SO.Range("A2").Resize(dic.Count, 7) = dizi

    With Application
        .ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .EnableEvents = True
    End With
    MsgBox "B i t t i"
End Sub

.

 

[Suddedly]

1004 hatası veriyor hocam satırı ise;

SO.Range("A2").Resize(dic.Count, 7) = dizi

 

[Emir Hüseyin Çoban]

.

Hata aldığınız dosyayı ekleyin. Kontrol edelim.

.

 

[Suddedly]

Buyrun.

http://s4.dosya.tc/server5/y64jfe/FASONSON.rar.html

 

[Emir Hüseyin Çoban]

.

Tablonun başına İRS NO (A) diye bir sütun daha eklemişsiniz.
O sütunu silerek deneyin.
Makro kodları, formüller gibi satır/sütun ekle/sil işlemlerinde otomatik güncellenmez.

.

 

[Suddedly]

Haklısınız hocam benim hatam. Sütunu silince çalıştı. Çok teşekkür ederim sağolun. Hayırlı işler.