• DİKKAT

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

Veri Birleştirme

S

Suddedly

Altın Üye
Katılım
7 Ekim 2010
Mesajlar
222
Excel Vers. ve Dili
Excel 365
Excel 2019
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
 
.

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

.
 
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
 

Ekli dosyalar

Emir Hüseyin Çoban' Alıntı:
.

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

.
Genişletmek için tıkla ...

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 :)
 
.

Kod: 
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

.
 
Ş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.
 
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.






Emir Hüseyin Çoban' Alıntı:
.

Kod: 
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

.
Genişletmek için tıkla ...
 
.


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

Kod: 
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

.
 
1004 hatası veriyor hocam satırı ise;

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

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

.
 
.

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.

.
 
Haklısınız hocam benim hatam. Sütunu silince çalıştı. Çok teşekkür ederim sağolun. Hayırlı işler.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst