dosyamdaki stok kodunu aynı olanları tek stok kodunda gösterme...

[selcukc1]

Merhaba;

ekte excel dosyamı gönderiyorum sistemimizde kullandığımız iade edeceğimiz ürünlerle ilgili dosyadır. içine problemimi yazdım tek satıra düşürmek istiyorum aynı olan ürünleri bununla ilgili dönüşlerinizi rica ediyorum teşekür ederim...
:???:

 

[Orion1]

Dosyanız ektedir.

Sub xxxx()
Dim sat As Long, k As Range, adr As String, i As Long, sat2 As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
sat = Cells(Rows.Count, "A").End(xlUp).Row
Range("E2:G" & Rows.Count).ClearContents
If sat < 2 Then
    MsgBox "İşlem yapılacak Stok kodu bulunamdı!!", vbCritical, "U Y A RI"
    Range("A2").Select
    Application.ScreenUpdating = True
    Exit Sub
End If
sat2 = 2
For i = 2 To sat
    If WorksheetFunction.CountIf(Range("A2:A" & i), Cells(i, "A").Value) = 1 Then
    Set k = Range("A2:A" & sat).Find(Cells(i, "A").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
            Cells(sat2, "E").Value = k.Value
            Do
                Cells(sat2, "F").Value = k.Offset(0, 1).Value
                Cells(sat2, "G").Value = k.Offset(0, 2).Value
                sat2 = sat2 + 1
                Set k = Range("A2:A" & sat).FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adr
        End If
    End If
Next i
Set k = Nothing
Application.ScreenUpdating = True
Range("E1").Select
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[cenkyldrm]

yapmak istediğini tam olarak anladığımdan emin değilim. Ancak bir kodta yer alan ürünlerin adetlerini ve bendenleri tek satırda listelemek istiyorsan pivot işini görür gibi geldi.

 

[selcukc1]

Dosyanız ektedir.

Sub xxxx()
Dim sat As Long, k As Range, adr As String, i As Long, sat2 As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
sat = Cells(Rows.Count, "A").End(xlUp).Row
Range("E2:G" & Rows.Count).ClearContents
If sat < 2 Then
    MsgBox "İşlem yapılacak Stok kodu bulunamdı!!", vbCritical, "U Y A RI"
    Range("A2").Select
    Application.ScreenUpdating = True
    Exit Sub
End If
sat2 = 2
For i = 2 To sat
    Set k = Range("A2:A" & sat).Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Cells(sat2, "E").Value = k.Value
        Do
            Cells(sat2, "F").Value = k.Offset(0, 1).Value
            Cells(sat2, "G").Value = k.Offset(0, 2).Value
            sat2 = sat2 + 1
            Set k = Range("A2:A" & sat).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
Next i
Set k = Nothing
Application.ScreenUpdating = True
Range("E1").Select
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

bu şekilde yaptığınız bizim istediğimiz sistemde olmuş ama aynı stok kodları olmaması gerekiyor mesela yazmış olduğunuz dosyada 308866-021 kodu bir kere kullanılacak yanında beden ve adet olacak, o ürünle ilgili bittikten sonra 309298-006 gelecek o da aynı şekilde beden ve adet dağılımı olacak... yani stok kodu mükerrer olmasın istiyoruz bununla ilgili örnek olarak ekte düzeltme yaptım tekrar dönüşlerinizi bekliyorum... teşekkürler...

 

[Orion1]

bu şekilde yaptığınız bizim istediğimiz sistemde olmuş ama aynı stok kodları olmaması gerekiyor mesela yazmış olduğunuz dosyada 308866-021 kodu bir kere kullanılacak yanında beden ve adet olacak, o ürünle ilgili bittikten sonra 309298-006 gelecek o da aynı şekilde beden ve adet dağılımı olacak... yani stok kodu mükerrer olmasın istiyoruz bununla ilgili örnek olarak ekte düzeltme yaptım tekrar dönüşlerinizi bekliyorum... teşekkürler...

Gerekli düzenlemeyi yaptım.Dosyayı 2 numaralı mesajdan indirebilirsiniz.

 

[selcukc1]

tamam çok teşekkür ederim elinize emeğinize sağlık :biggrin: