Sayfalar arası veri eşleştirme

Avantaj Market · 26 Aralık 2010

Şube 1 Stokları;

stok no ürün adı fiyat
12345 elma 1,00
23456 armut 3,00
34567 portakal 5,00
45678 muz 6,00

Şube 2 Stokları;

stok no ürün adı fiyat
12345 elma 2,00
23456 armut 3,00
34567 portakal 5,00
56789 kiwi 6,00

2 şubeli bir işletmede şubeler arasında tablolardaki gibi farklı fiyatta ürün ve farklı ürünlerin kayıtları var.
1. şubede elma 1 tl 2. şubede 2 tl, 1. şubede kiwinin 2. şubede ise muzun kaydı yok.
Benim sizlerden isteğim; 1. sayfadaki Şube 1 stoklarını 2. sayfadaki Şube 2 stokları ile eşleştirmek ve eğer elma stoğundaki gibi fiyat farkı varsa bunu göstermek.
Şube 1 de olup Şube 2 de olmayan stokları (veya tam tersi de olabilir) belirtmek için kullanabileceğimiz bir formül veya makro var mı? biraz uğraştım ama istediğim sonuçları bir türlü alamadım...

İhsan Tank · 26 Aralık 2010

sorunuzu bir örnek dosya ile destekleseniz
ve nasıl olacağını yazsanız belki daha çabuk yanıt alırsınız

Avantaj Market · 26 Aralık 2010

Dosya ekledim!

2 şube için tek stok yapmayı istiyorum ama şubeler arasında stoklarda farklılıklar var bir şubede olan stoklar diğrerinde yok aynısı olsa bile fiyatları farklı ben bunları tek bir stok sayfasında toplamak istiyorum

1. şubenin stoklarını yazdıracağız sonra 2. şubede olup 1. şubede olmayan stokları altına yazdıracağız eğer aynı stok kodu ve aynı isimdeki stoğun fiyatında şubeler arası bir fark varsa onu ayrı bir satırda göstereceğiz. umarım anlatabilmişimdir...

Orion1 · 26 Aralık 2010

Dosyanız ektedir.

Kod:

Option Base 1
Sub tekli_kayitler_59()
Dim j As Long, i As Long, n As Long, myarr(), list()
Dim sat As Long, deg As String, z As Object, list2(), s As Long
Sheets("Geçerli Stoklar").Select
Application.ScreenUpdating = False
Range("A2:E65536").ClearContents
Set z = CreateObject("Scripting.Dictionary")
ReDim myarr(1 To 5, 1 To 65535 * 2)
For j = 1 To 2
    sat = Sheets(j).Cells(65536, "A").End(xlUp).Row
    If sat > 1 Then
        list = Sheets(j).Range("A2:C" & sat).Value
        For i = 1 To UBound(list)
            deg = list(i, 1) & list(i, 2) & list(i, 3)
            deg = UCase(Replace(Replace(deg, "ı", "I"), "i", "İ"))
            If Not z.exists(deg) Then
                n = n + 1
                z.Add deg, n
                myarr(1, n) = list(i, 1)
                myarr(2, n) = list(i, 2)
                myarr(3, n) = list(i, 3)
                myarr(5, n) = Sheets(j).Name
            End If
            myarr(4, z.Item(deg)) = myarr(4, z.Item(deg)) + 1
        Next i
        Erase list
    End If
Next j
Set z = Nothing
ReDim Preserve myarr(1 To 5, 1 To n)
If n > 0 Then
    ReDim list2(1 To n, 1 To 5)
    For j = 1 To UBound(myarr, 2)
        If myarr(4, j) < 2 Then
            s = s + 1
            list2(s, 1) = myarr(1, j)
            list2(s, 2) = myarr(2, j)
            list2(s, 3) = myarr(3, j)
            list2(s, 4) = myarr(4, j)
            list2(s, 5) = myarr(5, j)
        End If
    Next j
    Range("A2").Resize(s, 5) = list2
    Erase list2
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamdır." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End If
Erase myarr
Application.ScreenUpdating = True
End Sub

İhsan Tank · 26 Aralık 2010

Avantaj Market' Alıntı:
Dosya ekledim!

2 şube için tek stok yapmayı istiyorum ama şubeler arasında stoklarda farklılıklar var bir şubede olan stoklar diğrerinde yok aynısı olsa bile fiyatları farklı ben bunları tek bir stok sayfasında toplamak istiyorum

1. şubenin stoklarını yazdıracağız sonra 2. şubede olup 1. şubede olmayan stokları altına yazdıracağız eğer aynı stok kodu ve aynı isimdeki stoğun fiyatında şubeler arası bir fark varsa onu ayrı bir satırda göstereceğiz. umarım anlatabilmişimdir...

Evren Hocam'ın kodu'na Alternatif Olmaz ama bir çalışma umarım işinize yarar. ( Evren Hocam'a teşekkür ederim )
eki inceler misiniz.
Notlar :
Mavi - Kırmızı Olan Yerdeki Formüller Dizi formülüdür.

Dizi Formülü Formül Hücreye Girildikten Sonra Enter Tuşuna Basmadan Ctrl+Shift+Enter Tuş Kombinasyonu İle Aktif Olmaktadır. Formülün Başında Ve Sonunda { } Bu İşaretler Çıkar Elle Eklediğiniz Takdirde Formül Hata Verir.

Kırmızı - Mavi Olan yerdeki formülleri silmeyiniz.
formüllerde 1000 satır baz alınmıştır. ( düşeyara olanlar hariç düşeyara olanlarda 65536 satır baz alınmıştır ).

Avantaj Market · 26 Aralık 2010

İhsan Tank' Alıntı:
Evren Hocam'ın kodu'na Alternatif Olmaz ama bir çalışma umarım işinize yarar. ( Evren Hocam'a teşekkür ederim )
eki inceler misiniz.
Notlar :
Mavi - Kırmızı Olan Yerdeki Formüller Dizi formülüdür.

Kırmızı - Mavi Olan yerdeki formülleri silmeyiniz.
formüllerde 1000 satır baz alınmıştır. ( düşeyara olanlar hariç düşeyara olanlarda 65536 satır baz alınmıştır ).

İhsan Bey sizin verdiğiniz örnekte fiyatlar çıkmıyor ayrıca aynı stoklar tekrar yazılıyor

Avantaj Market · 26 Aralık 2010

Evren Gizlen' Alıntı:

Dosyanız ektedir.

Kod:

Option Base 1
Sub tekli_kayitler_59()
Dim j As Long, i As Long, n As Long, myarr(), list()
Dim sat As Long, deg As String, z As Object, list2(), s As Long
Sheets("Geçerli Stoklar").Select
Application.ScreenUpdating = False
Range("A2:E65536").ClearContents
Set z = CreateObject("Scripting.Dictionary")
ReDim myarr(1 To 5, 1 To 65535 * 2)
For j = 1 To 2
    sat = Sheets(j).Cells(65536, "A").End(xlUp).Row
    If sat > 1 Then
        list = Sheets(j).Range("A2:C" & sat).Value
        For i = 1 To UBound(list)
            deg = list(i, 1) & list(i, 2) & list(i, 3)
            deg = UCase(Replace(Replace(deg, "ı", "I"), "i", "İ"))
            If Not z.exists(deg) Then
                n = n + 1
                z.Add deg, n
                myarr(1, n) = list(i, 1)
                myarr(2, n) = list(i, 2)
                myarr(3, n) = list(i, 3)
                myarr(5, n) = Sheets(j).Name
            End If
            myarr(4, z.Item(deg)) = myarr(4, z.Item(deg)) + 1
        Next i
        Erase list
    End If
Next j
Set z = Nothing
ReDim Preserve myarr(1 To 5, 1 To n)
If n > 0 Then
    ReDim list2(1 To n, 1 To 5)
    For j = 1 To UBound(myarr, 2)
        If myarr(4, j) < 2 Then
            s = s + 1
            list2(s, 1) = myarr(1, j)
            list2(s, 2) = myarr(2, j)
            list2(s, 3) = myarr(3, j)
            list2(s, 4) = myarr(4, j)
            list2(s, 5) = myarr(5, j)
        End If
    Next j
    Range("A2").Resize(s, 5) = list2
    Erase list2
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamdır." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End If
Erase myarr
Application.ScreenUpdating = True
End Sub

Aktar dediğim zaman makro güvenlik hatası çıkıyor

Güvenlik ayarını düşürünce çalışıyor ve muhteşem olmuş Allah razı olsun işimi çok kolaylaştırdınız tam 15 bin stok vardı...

İhsan Tank · 26 Aralık 2010

Avantaj Market' Alıntı:
İhsan Bey sizin verdiğiniz örnekte fiyatlar çıkmıyor ayrıca aynı stoklar tekrar yazılıyor

çıkıyorya
hemde ikiside ayrı ayrı
şube1 'i ayrı
şube2'yi ayrı -çıkartıyor

aynısını yazmaması lazım
dikkatli bakın
sizin işlemleriniz A ile D sütunlarında
evren hocamın dosyasına yorum yazmamışsınız

Orion1 · 26 Aralık 2010

15 bin stokta denedinizmi?
Çalışması ne kadar sürdü?Süre olarak?

Avantaj Market' Alıntı:
Aktar dediğim zaman makro güvenlik hatası çıkıyor
Güvenlik ayarını düşürünce çalışıyor ve muhteşem olmuş Allah razı olsun işimi çok kolaylaştırdınız tam 15 bin stok vardı...

Avantaj Market · 27 Aralık 2010

Evren Gizlen' Alıntı:
15 bin stokta denedinizmi?
Çalışması ne kadar sürdü?Süre olarak?

Birkaç saniye sürdü gerçekten müthiş performans!!!

Son bir şey daha var diyelim ki B sütununu bu özellikten muaf tutmak istiyoruz kodlarda nasıl bir değişiklik yapmamız lazım??? Sadece A ve C sütunlarını tarasın biraz uğraştım ama kodları tam çözemedim "A2:C" den mi yapacağız bunu?

Sayfalar arası veri eşleştirme

Avantaj Market

Ekli dosyalar

İhsan Tank

Misafir

Avantaj Market

Orion1

Uzman

Ekli dosyalar

İhsan Tank

Misafir

Ekli dosyalar

Avantaj Market

Avantaj Market

İhsan Tank

Misafir

Orion1

Uzman

Avantaj Market