raf kodu ile stok kodu ayır ve listele

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
174
Excel Vers. ve Dili
office 2010
sayfa 1 de karışık olan listem var... buradaki verileri sayfa 3 deki gibi listelemek istiyorum...

raf kodları ile stok kodları ayırıp , hangi stok hangi rafta bunu listeleyeceğim...
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki makroyu deneyin. Verilerinizin çokluğuna ve bilgisayarınızın durumuna göre işlem uzun sürebilir:

PHP:
Sub rafstok()
Application.ScreenUpdating = False
Set s1 = Sheets("STOK KODLARI")
Set s2 = Sheets("RAF KODLARI")
Set s3 = Sheets("İSTEDİĞİM")
eski = WorksheetFunction.Max(s3.Cells(Rows.Count, "A").End(3).Row, 2)
s3.Range("A2:B" & eski).ClearContents
son1 = s1.Cells(Rows.Count, "A").End(3).Row
son2 = s2.Cells(Rows.Count, "A").End(3).Row
For i = 2 To son1
    If WorksheetFunction.CountIf(s2.Range("A1:A" & son2), s1.Cells(i, "A")) > 0 Then
        For j = i + 1 To son1
            If WorksheetFunction.CountIf(s2.Range("A1:A" & son2), s1.Cells(j, "A")) = 0 Then
                yeni = s3.Cells(Rows.Count, "A").End(3).Row + 1
                s3.Cells(yeni, "A") = s1.Cells(j, "A")
                s3.Cells(yeni, "B") = s1.Cells(i, "A")
            Else
                i = j - 1
                j = son1
            End If
        Next
    End If
Next
s3.Activate
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı :)" & yeni & " adet ürün listelendi", vbInformation
End Sub
 

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
174
Excel Vers. ve Dili
office 2010
Aşağıdaki makroyu deneyin. Verilerinizin çokluğuna ve bilgisayarınızın durumuna göre işlem uzun sürebilir:

PHP:
Sub rafstok()
Application.ScreenUpdating = False
Set s1 = Sheets("STOK KODLARI")
Set s2 = Sheets("RAF KODLARI")
Set s3 = Sheets("İSTEDİĞİM")
eski = WorksheetFunction.Max(s3.Cells(Rows.Count, "A").End(3).Row, 2)
s3.Range("A2:B" & eski).ClearContents
son1 = s1.Cells(Rows.Count, "A").End(3).Row
son2 = s2.Cells(Rows.Count, "A").End(3).Row
For i = 2 To son1
    If WorksheetFunction.CountIf(s2.Range("A1:A" & son2), s1.Cells(i, "A")) > 0 Then
        For j = i + 1 To son1
            If WorksheetFunction.CountIf(s2.Range("A1:A" & son2), s1.Cells(j, "A")) = 0 Then
                yeni = s3.Cells(Rows.Count, "A").End(3).Row + 1
                s3.Cells(yeni, "A") = s1.Cells(j, "A")
                s3.Cells(yeni, "B") = s1.Cells(i, "A")
            Else
                i = j - 1
                j = son1
            End If
        Next
    End If
Next
s3.Activate
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı :)" & yeni & " adet ürün listelendi", vbInformation
End Sub
teşekkür ederim
 

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
174
Excel Vers. ve Dili
office 2010
burada birden fazla aynı stok kartı farklı raflarda varsa bütün raf kodlarının yanyana yazsın. düzenlerseniz çok sevirimm.
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları deneyiniz, işlem uzun sürebilir:

PHP:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Set stoklar = Sheets("STOK KODLARI")
Set raflar = Sheets("RAF KODLARI")
Set rapor = Sheets("EŞLEŞEN STOKLAR")

rapor.Cells.Clear
rapor.[A1] = "Stok Kodu"
sonstok = stoklar.Cells(Rows.Count, "A").End(3).Row
sonraf = raflar.Cells(Rows.Count, "A").End(3).Row
For raf = 2 To sonstok
    If WorksheetFunction.CountIf(raflar.Range("A1:A" & sonraf), stoklar.Cells(raf, "A")) > 0 Then
        For urun = raf + 1 To sonstok
            If WorksheetFunction.CountIf(raflar.Range("A1:A" & sonraf), stoklar.Cells(urun, "A")) = 0 Then
                yeni = rapor.Cells(Rows.Count, "A").End(3).Row + 1
                If WorksheetFunction.CountIf(rapor.Range("A1:A" & yeni), stoklar.Cells(urun, "A")) = 0 Then
                    rapor.Cells(yeni, "A") = stoklar.Cells(urun, "A")
                End If
                sat = WorksheetFunction.Match(stoklar.Cells(urun, "A"), rapor.Range("A1:A" & yeni), 0)
                sut = rapor.Cells(sat, Columns.Count).End(xlToLeft).Column + 1
                If rapor.Cells(1, sut) = "" Then
                    rapor.Cells(1, sut) = "Raf Yeri" & sut - 1
                End If
                rapor.Cells(sat, sut) = stoklar.Cells(raf, "A")
            Else
                raf = urun - 1
                urun = sonstok
            End If
        Next
    End If
Next
rapor.Activate

Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı :)" & chr(10) &chr(10) & yeni & " adet ürün listelendi", vbInformation
End Sub
 

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
174
Excel Vers. ve Dili
office 2010
Aşağıdaki kodları deneyiniz, işlem uzun sürebilir:

PHP:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Set stoklar = Sheets("STOK KODLARI")
Set raflar = Sheets("RAF KODLARI")
Set rapor = Sheets("EŞLEŞEN STOKLAR")

rapor.Cells.Clear
rapor.[A1] = "Stok Kodu"
sonstok = stoklar.Cells(Rows.Count, "A").End(3).Row
sonraf = raflar.Cells(Rows.Count, "A").End(3).Row
For raf = 2 To sonstok
    If WorksheetFunction.CountIf(raflar.Range("A1:A" & sonraf), stoklar.Cells(raf, "A")) > 0 Then
        For urun = raf + 1 To sonstok
            If WorksheetFunction.CountIf(raflar.Range("A1:A" & sonraf), stoklar.Cells(urun, "A")) = 0 Then
                yeni = rapor.Cells(Rows.Count, "A").End(3).Row + 1
                If WorksheetFunction.CountIf(rapor.Range("A1:A" & yeni), stoklar.Cells(urun, "A")) = 0 Then
                    rapor.Cells(yeni, "A") = stoklar.Cells(urun, "A")
                End If
                sat = WorksheetFunction.Match(stoklar.Cells(urun, "A"), rapor.Range("A1:A" & yeni), 0)
                sut = rapor.Cells(sat, Columns.Count).End(xlToLeft).Column + 1
                If rapor.Cells(1, sut) = "" Then
                    rapor.Cells(1, sut) = "Raf Yeri" & sut - 1
                End If
                rapor.Cells(sat, sut) = stoklar.Cells(raf, "A")
            Else
                raf = urun - 1
                urun = sonstok
            End If
        Next
    End If
Next
rapor.Activate

Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı :)" & chr(10) &chr(10) & yeni & " adet ürün listelendi", vbInformation
End Sub
çok teşekkür ederim
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Bende sıkıntı görünmüyor:

213450
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,158
Excel Vers. ve Dili
Ofis 2019 Türkçe
çoğunluğu bu şekilde gördüm, belki de konuyu anlayamamışımdır, stok kodlarını neye göre raflarla eşleştirdiğini de anlayamadım.
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sonuç raporunda A sütunu ürün kodlarını yandaki sütunlar da o ürünün hangi raflarda bulunduğunu gösteriyor. Bir ürün birden fazla rafta olabilir yani.
 

sevensuleyman

Altın Üye
Katılım
9 Kasım 2012
Mesajlar
174
Excel Vers. ve Dili
office 2010
yaptıgınız işlemde sıkıntı yok .. stok kodu ve raf kodlarını çoğalttıgımızdan dolayı raf kodları aynı çıkıyor.. raf kodu ve stok kodları tek oldugu zaman sıkıntısız çalışıyor.. çok teşekkür ederim
 
Üst