Копирование данных из каждого столбца на основе, если условие

Question

У меня есть данные в листе, который выглядит как

A  B  C  D 
     1001 1002 1003 
Phone 1  1  1 
TV  1    1 
Remote    1 
AC  1  1  1 

Я хочу макрос, который дает данные в другом листе что-то вроде

Phone 1001;1002;1003 
TV  1001;1003 
Remote 1003 
AC  1001;1002;1003 

в 2 Столбцы

Это пример данных, столбцы и строки меняются каждый раз, когда большие числа говорят до 1000. Так что мне нужен макрос, чтобы получить данные из первой строки, только если соответствующий cel В нем есть «1».

Answer 1

Это может помочь ..

Sub Init() 
Dim x, y As Integer 
Dim s As String 
Dim xt As Worksheet 

Set xt = Sheets("Sheet2")'----------> you may change this 

For y = 2 To 6 '--------------------tv,remote,etc 
    s = "" 
    For x = 2 To 4 '------------------1001,1002,1003 
    If Cells(y, x) = 1 Then 
     If Len(s) > 0 Then s = s & "; " 
     s = s & Cells(1, x) 
    End If 
    Next 
    xt.Cells(y, 1) = Cells(y, 1) 
    xt.Cells(y, 2) = s 
Next 
End Sub