Tablo karşılaştırma hakkında

[cnisik]

Merhaba,

Kullanmış olduğumuz pastane satış programında son bir ayın günlük satış miktarlarını gösteren (Ürün/Gün/Miktar) raporu aldığımızda exelde bize alttaki gibi bir tablo veriyor.

A1 de Ürün listesi, A2 Den A200 e kadar
B2 de satış yapılan tarihler B2 Den B31 a kadar,

Şubelerimizde gün sonunda son kullanma tarihi dolan ürünümüz varsa stokdan düşme adına zayi olarak giriş yapılıyor. Ama program üstteki aldığımız raporda bu zayi kapamaları da satış gibi algılıyor ve satış rakamlarında onlar da görünmüş oluyor.

Ayrı bir raporda satış zayilerini exele indirip görebiliyoruz. Tablo aynı üstteki tablo gibi oluyor.

Benim isteğim zayi raporunu satış raporundan çıkarmak.
Burada işlemi zorlaştıran şey, satış raporunda satışı görünen her ürün zayi raporunda olmayabiliyor. Sonuçta zayi her gün 5-10 üründe olabiliyor.
Burada istediğim formül zayi olan ürünü satış raporunda bulup zayi olan tarihe denk gelen tarihten çıkararak net satış verisi elde etmek.
Örneğin 26 temmuzda sütlü simit 1 adet zayi görünüyor, satış raporunda sütlü simit satışının 26 temmuzdaki verisinden 1 adet düşerek yeni veriyi vermesi.


Dosya: https://disk.yandex.com.tr/d/BZT60UjB4zg3MA

Şimdiden teşekkürler

 

[Necdet]

Merhaba,
Örnek dosyanızı paylaşım sitelerinden birine (dosya.tc, dosya.co gibi) yükleyebilirsiniz.

 

[cnisik]

Merhaba,
Örnek dosyanızı paylaşım sitelerinden birine (dosya.tc, dosya.co gibi) yükleyebilirsiniz.

Bilgilendirme için teşekkürler.

 

[cnisik]

Yardımcı olabilecek yok mu acaba

 

[Necdet]

Merhaba,

Sayfalar arasında satır ve sütun farklılıkları var.
Dolayısıyla fonksiyonlarla da makro ile de çözüm şişirecektir dosyayı.

3 sayfa da aynı formatta aynı satır ve sütun sayısında ve değerler aynı satır ve sütunda olsa hiç bir sıkıntı bile olmazdı.

 

[cnisik]

Merhaba,

Sayfalar arasında satır ve sütun farklılıkları var.
Dolayısıyla fonksiyonlarla da makro ile de çözüm şişirecektir dosyayı.

3 sayfa da aynı formatta aynı satır ve sütun sayısında ve değerler aynı satır ve sütunda olsa hiç bir sıkıntı bile olmazdı.

Benim sorunum da o sayfa 1 de yer alan ürün listesindeki bazı ürünler sayfa 2 de yok o yüzden karmaşıklaşıyor.
Sanırım biraz daha uğraşıp önce sayfa 1 de olup sayfa 2 de olmayanları tespit edip sonra sütunları eşitledikten sonra sayfa 2 deki değerleri sayfa 1den çıkarıp çıkan sonucu tekrar sayfa 1 e gerçek değerler olarak aktarmak olacak. başka bir çözüm bulamadım.

 

[Necdet]

Merhaba,

Değişken satır ve sütunlar dikkate alınarak hazırladığım kodları bir modüle kopyalayıp dener misiniz.

Public Sub Fark_Bul()
                            'Referanslardan Microsoft Scripting Runtime MODÜLÜ SEÇİLİ OLMALI
Dim dic As New Dictionary, _
    arr As Variant, _
    arS As Variant, _
    deg As Variant, _
    i   As Long, _
    j   As Long, _
    lR  As Long, _
    k   As Integer, _
    col As Integer, _
    t1  As Date, _
    t2  As Date

t1 = Date + 2000

For i = 1 To 2
    arS = Sheets(i).Range("A1").CurrentRegion.Value
'    If UBound(arS, 2) > col Then col = UBound(arS, 2)
    If arS(1, 2) < t1 Then t1 = arS(1, 2)
    If arS(1, UBound(arS, 2)) > t2 Then t2 = arS(1, UBound(arS, 2))
    For j = LBound(arS, 1) To UBound(arS, 1)
        If Not dic.Exists(arS(j, 1)) Then dic.Add arS(j, 1), ""
    Next j
Next i

deg = dic.Keys
deg = SortArrayAtoZ(deg)

col = t2 - t1 + 2

ReDim arr(1 To dic.Count, 1 To col)

'arr stok adları yazdırılır
For i = LBound(deg) To UBound(deg)
    arr(i + 1, 1) = deg(i)
Next i
'arr sütuna tarihler yazdırılır
For i = 2 To UBound(arr, 2)
    arr(1, i) = t1
    t1 = t1 + 1
Next i

'Aktarım ve Hesaplamalar
For i = 1 To 2
    arS = Sheets(i).Range("A1").CurrentRegion.Value
    col = arS(1, 2) - arr(1, 2)
    For j = 2 To UBound(arS, 1)
        lR = Application.WorksheetFunction.Match(arS(j, 1), deg, 0)
        For k = 2 To UBound(arS, 2)
            If i = 1 Then
                arr(lR, k + col) = arS(j, k)
            Else
                arr(lR, k + col) = arr(lR, k + col) - arS(j, k)
            End If
        Next k
    Next j
Next i

With Sayfa3
    .Select
    .Range("A1").CurrentRegion.ClearContents
    .Range("A1").Resize(dic.Count, UBound(arr, 2)) = arr
    ActiveWindow.DisplayZeros = False
End With

End Sub

Function SortArrayAtoZ(myArray As Variant)

Dim i As Long
Dim j As Long
Dim Temp

'Sort the Array A-Z
For i = LBound(myArray) + 1 To UBound(myArray) - 1
    For j = i + 1 To UBound(myArray)
        If UCase(myArray(i)) > UCase(myArray(j)) Then
            Temp = myArray(j)
            myArray(j) = myArray(i)
            myArray(i) = Temp
        End If
    Next j
Next i

SortArrayAtoZ = myArray

End Function

Dosya Linki İçin TIKLAYINIZ

 

[Necdet]

Merhaba,
Dosya lüzerinde biraz daha çalıştım.
Satır ve Sütun sayılarını dikkate alan, tarih sütunlarının karışık işlendiğini varsayan kodları ekliyorum.
Her ne kadar arkadaşımız ilgilenmese de biz yine kodları ekleyelim.

Yine Referanslardan Microsoft Scripting Runtime Modülünün seçili olması gerek.

Public Sub FarkBul()

Dim dic As New Dictionary, _
    arL As Variant, _
    arS As Variant, _
    i   As Long, _
    j   As Long, _
    sat As Long, _
    s   As Integer, _
    col As Integer, _
    tBs As Date, _
    tBt As Date, _
    tar As Variant, _
    stk As Variant
   
tBs = Date + 2000

For s = 1 To 2
    arS = Sheets(s).Range("A1").CurrentRegion.Value
    'En Küçük Ve En Büyük Tarih Bulunur
    For i = 2 To UBound(arS, 2)
        If arS(1, i) < tBs Then tBs = arS(1, i)
        If arS(1, i) > tBt Then tBt = arS(1, i)
    Next i
    'Stok Adlarını Belirleme
    For i = LBound(arS, 1) To UBound(arS, 1)
        If Not dic.Exists(arS(i, 1)) Then
            j = j + 1
            dic.Add arS(i, 1), j
        End If
    Next i
Next s

col = tBt - tBs + 2 'Yeni Oluşturulacak Sayfanın Sütun Sayısı
                    'dic.Count Yeni Oluşturulacak Sayfanın Satır Sayısı
ReDim arL(1 To dic.Count, 1 To col)
ReDim tar(1 To col)
stk = dic.Keys
stk = SortArrayAtoZ(stk)    'Stok Adları Sıralanır

'STOK ADI ARL dizinine Aktarılır
For i = LBound(stk) To UBound(stk)
    arL(i + 1, 1) = stk(i)
Next i

'Tarihler arL dizinin 1. satırına aktarılır
For i = 2 To UBound(arL, 2)
    arL(1, i) = tBs
    tar(i) = CDbl(tBs)
    tBs = tBs + 1
Next i

'arL dizisine Sayfa1 ve Sayfa2 verilerinin aktarılması
For s = 1 To 2
    arS = Sheets(s).Range("A1").CurrentRegion.Value
    For i = LBound(arS, 1) + 1 To UBound(arS, 1)
        sat = Application.WorksheetFunction.Match(arS(i, 1), stk, 0)
        For j = 2 To UBound(arS, 2)
            col = Application.Match(CDbl(arS(1, j)), tar, 0)
            If s = 1 Then
                arL(sat, col) = arS(i, j)
            Else
                arL(sat, col) = arL(sat, col) - arS(i, j)
            End If
        Next j
    Next i
Next s

With Sayfa3
    .Select
    .Cells.ClearContents
    .Range("A1").Resize(UBound(arL, 1), UBound(arL, 2)) = arL
'    With ActiveWindow
'        .DisplayGridlines = False
'        .DisplayZeros = False
'    End With
End With

End Sub

 

[cnisik]

Hocam çok teşekkürler, ilgilenmemek değil kusura bakmayın dün ay son sayımım olduğu için 1-2 gündür onunla uğraşıyorum öncesinde hazırlık da vardı. İlk verdiğiniz dosyayı indirdim kontrol ettim çalışıyor gibiydi ama detaylı bakamadım, zahmet edip tekrar üstüne çalışmıssınız teşekkürler.

 

[Necdet]

Merhaba,
ikinci kodlarda tarihlerin sıralı gitmesi gerekmiyor, bir sayfada olan tarih diğer sayfada olmayabilir.
İkinci kodları kullanın derim.
Kontrol etmediğim şey Stok Kodlarının düzgün yazılması. Aynı gibi görünen her iki stok kodu 3. sayfada görülebilir.

 

[cnisik]

Merhaba,
ikinci kodlarda tarihlerin sıralı gitmesi gerekmiyor, bir sayfada olan tarih diğer sayfada olmayabilir.
İkinci kodları kullanın derim.
Kontrol etmediğim şey Stok Kodlarının düzgün yazılması. Aynı gibi görünen her iki stok kodu 3. sayfada görülebilir.

İlginiz için teşekkür

 

[cnisik]

Merhaba,
ikinci kodlarda tarihlerin sıralı gitmesi gerekmiyor, bir sayfada olan tarih diğer sayfada olmayabilir.
İkinci kodları kullanın derim.
Kontrol etmediğim şey Stok Kodlarının düzgün yazılması. Aynı gibi görünen her iki stok kodu 3. sayfada görülebilir.

Hocam ya ben yapamadım ya da kodlamada hata var makroyu çalıştırınca hata alıyorum.
https://www.hizliresim.com/8uxsh18

 

[Necdet]

vba penceresi içinde
Tools
referanslardan
Microsoft Scriptin Runtime modülü seçili olmalı.
Bunu seçmediğiniz için hata alıyorsunuzdur

 

[cnisik]

vba penceresi içinde
Tools
referanslardan
Microsoft Scriptin Runtime modülü seçili olmalı.
Bunu seçmediğiniz için hata alıyorsunuzdur
Ekli dosyayı görüntüle 245798

Kontrol ettim hocam seçili,
https://www.hizliresim.com/hrgv4o1

rica etsem excele yükleyip paylaşabilir misiniz

 

[Necdet]

O zaman tek bir neden kaldı.
Ben sayfalarda Sayfa adını değil Sayfa indisini kullandım.
Büyük olasılıkla sizin sayfa indisleriniz farklı.

Bunu da View/Properties (F4) ile değiştirebilirsiniz.
Sizin Satış olarak adlandırdığınız Sayfanın indisi Sayfa1, zayi olarak adlandırdığınız sayfanın indisi Sayfa2, diğeri de Sayfa3 olmalı.
olmazsa paylaşım sitelerinden birine dosyanızı ekleyin, bakayım.

 

[cnisik]

O zaman tek bir neden kaldı.
Ben sayfalarda Sayfa adını değil Sayfa indisini kullandım.
Büyük olasılıkla sizin sayfa indisleriniz farklı.

Bunu da View/Properties (F4) ile değiştirebilirsiniz.
Sizin Satış olarak adlandırdığınız Sayfanın indisi Sayfa1, zayi olarak adlandırdığınız sayfanın indisi Sayfa2, diğeri de Sayfa3 olmalı.
olmazsa paylaşım sitelerinden birine dosyanızı ekleyin, bakayım.

Ekli dosyayı görüntüle 245799

Dediğiniz şekilde yapınca da olmadı hocam, aynı hatayı verdi.

https://disk.yandex.com.tr/i/y0lYJ7hdsfl9eQ

 

[Necdet]

Merhaba,
Sıralama Fonksiyonu Yok, ona veriyor hatayı.
Aşağıdaki kodu da bir modüle ya da mevcut modüldeki kodların altına ekleyiniz.

Function SortArrayAtoZ(myArray As Variant)

Dim i As Long
Dim j As Long
Dim Temp

'Sort the Array A-Z
For i = LBound(myArray) + 1 To UBound(myArray) - 1
    For j = i + 1 To UBound(myArray)
        If UCase(myArray(i)) > UCase(myArray(j)) Then
            Temp = myArray(j)
            myArray(j) = myArray(i)
            myArray(i) = Temp
        End If
    Next j
Next i

SortArrayAtoZ = myArray

End Function