Sayfa karşılaştırma

[arrow3441]

Merhaba ektedeki dosyada 2 sayfa var merkez ve sube olarak Olmayanlar sayfasına bu iki sayfasındaki stokkodlarını kontrol ederek merkezde olan sube sayfasında olmayan stokları Olmayanlar sayfasına aktarması . STOKKODU , MALINCINSI , ENVANTER olarak . Diğer istediğimde stokdurumu sayfasına 2 sayfada olan stokkodlarını kontrol ederek Sube sayfasında envanter 2 ' nin altında olanları stokdurumu sayfasına raporlaması . Teşekkür ederim şimdiden

 

[arrow3441]

yardımcı olabilen varmıdır

 

[Haluk]

Merkez'de olup, Şubede olmayan ürünler için;

Sub CheckSube()
'   Haluk - 03/02/2024
    Dim objConn As Object, RS As Object, strArgs As String, i As Integer, strTemp As String, strSQL As String
   
    Sheets("Olmayanlar").Range("A2:C" & Rows.Count) = ""
   
    Set objConn = CreateObject("ADODB.Connection")
   
    strArgs = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; Readonly=False; DBQ=" & ThisWorkbook.FullName
    objConn.Open strArgs
   
    strSQL = "Select Table1.[STOKKODU], Table1.[MALINCINSI], Table1.[ENVANTER] " & _
             "From [Merkez$] as Table1 " & _
             "Left Join " & _
             "[Sube$] As Table2 " & _
             "On Table1.[STOKKODU] = Table2.[BARCODE] Where Table2.[BARCODE] Is Null"
       
    Set RS = objConn.Execute(strSQL)
    Sheets("Olmayanlar").Range("A2").CopyFromRecordset RS

    objConn.Close
    Set objConn = Nothing
End Sub

Şubede, mevcudu 2'den az olan ürünler için;

Sub CheckQTY()
'   Haluk - 03/02/2024
    Dim objConn As Object, RS As Object, strArgs As String, i As Integer, strTemp As String, strSQL As String
    
    Sheets("Stokdurumu").Range("A2:C" & Rows.Count) = ""
    
    Set objConn = CreateObject("ADODB.Connection")
    
    strArgs = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; Readonly=False; DBQ=" & ThisWorkbook.FullName
    objConn.Open strArgs
    
    strSQL = "Select [BARCODE], [MALINCINSI], [SHOPSTOK] From [Sube$] Where [SHOPSTOK]<2 "
        
    Set RS = objConn.Execute(strSQL)
    Sheets("Stokdurumu").Range("A2").CopyFromRecordset RS

    objConn.Close
    Set objConn = Nothing
End Sub

.

 

[arrow3441]

Haluk hocam çok teşekkür ederim olmayanlar çok güzel çalıştı . Fakat diğer işlem için merkezde ve şubede olanlar için karşılaştırma yaparak şube sayfasında 2 den az olanları listelemesi

 

[Haluk]

"Karşılaştırma" ifadesinden neyi kasttiğinizi anlamadım......

Hem Şube'de hem Merkez'de olacak ama Şubede 2'den az olanlar mı listelenecek?

.

 

[arrow3441]

evet hocam doğrudur

 

[Haluk]

Aşağıdaki kod, Şubede 2'den az olan stokları Merkez'de arar ve hem Şubede hem de Merkez'deki mevcutları yazar.... Böylesi daha kullanışlı olacaktır.

Sub CheckQTY()
'   Haluk - 03/02/2024
    Dim objConn As Object, RS As Object, strArgs As String, i As Integer, strTemp As String, strSQL As String
    
    Sheets("Stokdurumu").Range("A2:C" & Rows.Count) = ""
    Sheets("Stokdurumu").Range("A1:D1") = Array("Barkod", "MalinCinsi", "SubeStok", "MerkezStok")
    Sheets("Stokdurumu").Range("A1:B1").ColumnWidth = 20
    Sheets("Stokdurumu").Range("C1:D1").ColumnWidth = 10
    
    Set objConn = CreateObject("ADODB.Connection")
    
    strArgs = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; Readonly=False; DBQ=" & ThisWorkbook.FullName
    objConn.Open strArgs
    
    strSQL = "Select Table1.[BARCODE], Table1.[MALINCINSI], Table1.[SHOPSTOK], Table2.[ENVANTER] " & _
             "From [Sube$] as Table1 " & _
             "Left Join " & _
             "[Merkez$] As Table2 " & _
             "On Table1.[BARCODE] = Table2.[STOKKODU] Where Table1.[SHOPSTOK] < 2 And Table2.[STOKKODU] Is Not Null"
        
    Set RS = objConn.Execute(strSQL)
    Sheets("Stokdurumu").Range("A2").CopyFromRecordset RS

    objConn.Close
    Set objConn = Nothing
End Sub

 

[arrow3441]

Çok teşekkür ederim hocam elinize emeğinize sağlık