0

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

矩阵看起来像：

用户名| 史密斯| 消耗| tjones
 包装标识|
     ABC| XX
     定义| XO
     吉| XX

我需要更改格式：

用户名|WrapID | 价值
杰史密斯 | 美国广播公司 | X
杰史密斯 | 吉 | X
bspence | 定义 | ○
bspence | 吉 | X
琼斯 | 美国广播公司 | X

我已经尝试加入我能想到的每一个公式，if(index(match) 等等，我完全不知所措。我不知道任何 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

结束子

许多Thnaks

问候，

4

1 回答 1

2 
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
于 2013-08-28T15:57:16.920 回答