Матрица для столбца excel vba code

Question

У меня есть матрица имен пользователей, работающих вверху, и имена приложений (обертывания), бегущие по стороне. Мы поместили X в каждую ячейку, где конкретный человек использует приложение, но теперь нам нужно создать стандартную таблицу из 2 столбцов: Имя пользователя & Имя приложения, а затем укажите пользователей и соответствующее приложение.

Матрица выглядит следующим образом:

 
Username| jsmith| bspence| tjones 
Wrap ID| 
    abc|   X  X 
    def| X  O 
    ghi| X  X 

Мне нужно, чтобы изменить формат:

 
Username|WrapID | value 
Jsmith | abc  | X 
Jsmith | ghi  | X 
bspence | def | O 
bspence | ghi | X 
tjones | abc  | X 

Я попытался присоединиться каждую формулу я могу думать, если (индекс (матч) среди других и я не знаю ни одного VB, но похоже, что это единственное решение проблемы.

Любые помощь по достоинству оценены.

Я сделал такой код, но это дает мне ошибки.

Sub ConvertMatrix() 
Dim lngX As Long, vIn, vUser, vOut 
Dim i As Long, j As Long, rngIn As Range, k As Long 
Set rngIn = [a1].CurrentRegion 
vIn = rngIn.Offset(1, 0).Resize(rngIn.Rows.Count - 1).Value 
vUser = rngIn.Resize(, rngIn.Columns.Count - 1).Offset(, 1).Rows(1).Value 
lngX = Application.WorksheetFunction.CountIf(rngIn, "X") 
Redim vOut(1 To lngX, 1 To 3) 
For i = 1 To UBound(vUser, 2) 
    For j = 1 To UBound(vIn, 1) 
     If vIn(j, i + 1) = "X" Then 
      k = k + 1 
      vOut(k, 1) = vUser(1, i) 
      vOut(k, 2) = vIn(j, 1) 
      vOut(k, 3) = vIn(j, i + 1) 
     End If 
    Next 
Next 
With Worksheets.Add 
    .Range("A1:B1") = Array("User", "WrapID", "value") 
    .Range("A2").Resize(UBound(vOut, 1), 3).Value = vOut 
End With 

End Sub

Многие Thnaks

С уважением,

Answer 1

Sub ConvertMatrix() 

    Dim arrMatrix As Variant 
    Dim arrResults() As Variant 
    Dim ResultIndex As Long 
    Dim rIndex As Long 
    Dim cIndex As Long 

    With Range("A1").CurrentRegion 
     arrMatrix = .Value 
     If Not IsArray(arrMatrix) Then Exit Sub 'No data 
     ReDim arrResults(1 To WorksheetFunction.CountA(.Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)), 1 To 3) 
    End With 

    For cIndex = 2 To UBound(arrMatrix, 2) 
     For rIndex = 3 To UBound(arrMatrix, 1) 
      If Len(arrMatrix(rIndex, cIndex)) > 0 Then 
       ResultIndex = ResultIndex + 1 
       arrResults(ResultIndex, 1) = arrMatrix(1, cIndex) 
       arrResults(ResultIndex, 2) = arrMatrix(rIndex, 1) 
       arrResults(ResultIndex, 3) = arrMatrix(rIndex, cIndex) 
      End If 
     Next rIndex 
    Next cIndex 

    If ResultIndex > 0 Then 
     With Sheets.Add(After:=Sheets(Sheets.Count)) 
      With .Range("A1").Resize(, UBound(arrResults, 2)) 
       .Value = Array("Username", "WrapID", "Value") 
       .Font.Bold = True 
       .Borders(xlEdgeBottom).LineStyle = xlContinuous 
      End With 
      .Range("A2").Resize(ResultIndex, UBound(arrResults, 2)).Value = arrResults 
      .UsedRange.EntireColumn.AutoFit 
     End With 
    End If 

    Erase arrMatrix 
    Erase arrResults 

End Sub