[حل شده] لیست معایب

[ali.b]

سلام
طبق فایل پیوست چطورمیشه کاری کرد معایب هر ردیف رو لیست کرد
منهرکدیمیزنم نمیدونماشکال از کجاست کهدر یک سلول یا ی ستون از لیست باکس کنار هم نمیاره باید سلول جدا داشته در حالی که نیاز دارم معایب کنار یا در یک سلول باهم باشند
نمونه پیوست کردم.

[iranweld]

با سلام

فایل پیوست را ملاحظه کنید

Sub test()

k = 3

z1 = Cells(Rows.Count, "A").End(xlUp).Row

z2 = Cells(Rows.Count, "j").End(xlUp).Row + 3

Range("j3:k" & z2).ClearContents


For i = 2 To z1

If Application.CountIf(Range("b2:b" & i), Range("b" & i)) = 1 Then

For j = 3 To 5


If Cells(i, j) = "" Then

If xx = "" Then

xx = Cells(1, j)

Else

xx = xx & "/" & Cells(1, j)


End If

End If


Next

If xx <> "" Then

Range("j" & k) = i - 1

Range("k" & k) = xx

k = k + 1

xx = ""

End If

Else

Range("j" & k) = i - 1

Range("k" & k) = "ʘÑÇÑí : " & Range("b" & i)

k = k + 1

End If

Next


End Sub 

[ali.b]

با سلام

فایل پیوست را ملاحظه کنید

Sub test()

k = 3

z1 = Cells(Rows.Count, "A").End(xlUp).Row

z2 = Cells(Rows.Count, "j").End(xlUp).Row + 3

Range("j3:k" & z2).ClearContents


For i = 2 To z1

If Application.CountIf(Range("b2:b" & i), Range("b" & i)) = 1 Then

For j = 3 To 5


If Cells(i, j) = "" Then

If xx = "" Then

xx = Cells(1, j)

Else

xx = xx & "/" & Cells(1, j)


End If

End If


Next

If xx <> "" Then

Range("j" & k) = i - 1

Range("k" & k) = xx

k = k + 1

xx = ""

End If

Else

Range("j" & k) = i - 1

Range("k" & k) = "ʘÑÇÑí : " & Range("b" & i)

k = k + 1

End If

Next


End Sub 

خیلی عالی ممنونم