[حل شده] استخراج داده های ستون و جمع آنها در یک سلول همراه با درج کلمه or بین هر کدام !

[Skynet]

با سلام و احترام خدمت عزیزان

من در فایلم 8 ستون دارم که هر کدام با یک عنوان گروه بندی شدند. که فرمت سلول ها متنی هست ، قصد دارم کد های موجود در هر ستون (گروه ) رو در یک سلول با نام گروه مربوطه همه رو با درج کلمه OR بین هر کدام بصورت مجموع بیارم.
و در یک سلول دیگه، کدهای وارد شده که بین هر کدام کلمه OR درج شده را، مجداا" بصورت مجموع بیارم و بین هر رشته کلمه OR را قراردهم.
خیلی خیلی ممنون میشم اگر راهنمایی بفرمایید. ممنونم

لینک فایل مربوطه :
http://s8.picofile.com/file/8349100868/Code_wite_OR.xlsx.html

[Skynet]

استادان عزیز اگر لطف کنید راهنمایی بفرمایید خیلی خیلی ممنون میشم

[iranweld]

با سلام

از کدهای ذیل استفاده کنید

Sub test()

Dim i As Integer

Dim xx As String

k = 12

lastcolumn = Range("B7").End(xlToRight).Column

For j = 2 To lastcolumn

EndRow = Cells(Rows.Count, j).End(xlUp).Row

For i = 8 To EndRow

If Len(xx) = 0 And Cells(i, j) <> "" Then

xx = Cells(7, j) & "-" & Cells(i, j)


ElseIf Len(xx) > 0 And Cells(i, j) <> "" Then

xx = xx & " OR " & Cells(7, j) & "-" & Cells(i, j)


End If

Next

Cells(11, k) = xx

k = k + 1

xx = ""

Next



lastcolumn = Range("B7").End(xlToRight).Column

For j = 2 To lastcolumn

EndRow = Cells(Rows.Count, j).End(xlUp).Row

For i = 8 To EndRow

If Len(kk) = 0 And Cells(i, j) <> "" Then


kk = Cells(7, j) & "-" & Cells(i, j)

ElseIf Len(kk) > 0 And Cells(i, j) <> "" Then


kk = kk & " OR " & Cells(7, j) & "-" & Cells(i, j)

End If

Next


Next

Range("l5") = kk


MsgBox kk

End Sub 

[Skynet]

با سلام

از کدهای ذیل استفاده کنید

Sub test()

Dim i As Integer

Dim xx As String

k = 12

lastcolumn = Range("B7").End(xlToRight).Column

For j = 2 To lastcolumn

EndRow = Cells(Rows.Count, j).End(xlUp).Row

For i = 8 To EndRow

If Len(xx) = 0 And Cells(i, j) <> "" Then

xx = Cells(7, j) & "-" & Cells(i, j)


ElseIf Len(xx) > 0 And Cells(i, j) <> "" Then

xx = xx & " OR " & Cells(7, j) & "-" & Cells(i, j)


End If

Next

Cells(11, k) = xx

k = k + 1

xx = ""

Next



lastcolumn = Range("B7").End(xlToRight).Column

For j = 2 To lastcolumn

EndRow = Cells(Rows.Count, j).End(xlUp).Row

For i = 8 To EndRow

If Len(kk) = 0 And Cells(i, j) <> "" Then


kk = Cells(7, j) & "-" & Cells(i, j)

ElseIf Len(kk) > 0 And Cells(i, j) <> "" Then


kk = kk & " OR " & Cells(7, j) & "-" & Cells(i, j)

End If

Next


Next

Range("l5") = kk


MsgBox kk

End Sub 

سلام استاد عزیز iranweld

همیشه لطف شما مشمول حال ما و دوستداران اکسل بوده ، بی نهایت ممنونم از حل این مسئله