matrix列excel vba代码

我有一个沿顶部运行的用户名matrix和应用程序名称（包装）在侧面运行。 我们在每个单元格中放置了一个X，其中一个特定的人使用了一个应用程序，但是现在我们需要制作一个标准的2列列表：用户名和应用程序名称，然后列出用户和相关的应用程序。

matrix看起来像：

用户名|  JSMITH |  bspence |  tjones 
 换行ID |
      ABC |  XX
     高清|  XO
      GHI |  XX

我需要改变格式：

用户名| WrapID | 值
 Jsmith |  abc |  X
 Jsmith |  ghi |  X
 bspence |  def |  Ø
 bspence |  ghi |  X
 tjones |  abc |  X

我尝试join我能想到的每一个公式，如果（索引（匹配）和其他完整的损失。我不知道任何VB，但它看起来像这是唯一的解决scheme。

任何援助真诚赞赏。

我做了这样的代码，但这给了我错误。

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 

结束小组

许多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