arrays - 转置满足条件的行中的值

Question

我正在尝试分析各个公司为特定火车旅程提供的折扣，并相应地列出公司名称和折扣。

输入数据集如下图所示:



我想要做的基本上是转置数据集并创建折扣> 0 的以下输出并返回公司/列名称。 (见下文)



我尝试使用以下公式:

{=INDEX(A1:F7,SMALL(IF(AND(A2:A7=H2,B2:F2>0),COLUMNS(B1:F1)),COLUMNS(1:1))-1,3)} 

- 这似乎总是产生#NUM!错误

=INDEX(A1:F7, MATCH(H2,A2:A7,0),MATCH(I2,B1:F1,0))

这仅适用于我列出了所有可能的路线并且每个公司都有一条路线，即使折扣为 0。鉴于我有 40 家公司和 15000 多条路线，我真的不想创建一个长列表LONPAR 与 B 列中的每个公司，然后是 LONFRA 等。

有什么我遗漏的东西，或者您可以提供的任何指导或功能来帮助我获得解决方案吗？

Answer 1

以下代码似乎相当有效地拆分了您的火车折扣表。

Option Explicit

Sub qwewretq()
    Dim a As Long, b As Long, h As Long, aDISs As Variant

    With Worksheets("Sheet10")
        With .Cells(1, 1).CurrentRegion
            aDISs = .Cells.Value2
            h = .Columns.Count + 2
        End With
        .Cells(1, h).CurrentRegion.ClearContents
        .Cells(1, h).Resize(1, 3) = Array("route", "company", "discount")
        For a = 2 To UBound(aDISs, 1)
            For b = 2 To UBound(aDISs, 2)
                If aDISs(a, b) > 0 Then
                    If IsError(Application.Match(aDISs(a, 1), .Columns(h), 0)) Then
                        .Cells(Rows.Count, h + 1).End(xlUp).Offset(1, -1) = aDISs(a, 1)
                    End If
                    .Cells(Rows.Count, h + 1).End(xlUp).Offset(1, 0).Resize(1, 2) = _
                        Array(aDISs(1, b), aDISs(a, b))
                End If
            Next b
        Next a
    End With
End Sub

有些区域可以进行调整以提高效率，特别是应用程序环境设置，如 .ScreenUpdating property和 .EnableEvents property .对于非常大的数据 block ，构建目标数组并将解析的数据整体转储回工作表也可能会有所帮助。您应该能够相当容易地格式化目标表的百分比和任何视觉美化。