转置满足条件的行中的值

Question

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

输入数据集如下图所示：

我想做的基本上是转置数据集并创建以下输出，其中折扣 > 0 和 return company/column 名称。（见下文）

我尝试使用以下公式：

{=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 多条路线，我真的不想将在 B 列中为每个公司创建一长串 LONPAR，然后是 LONFRA 等。

是否有任何我遗漏的内容，或者您可以提供任何指导或功能来帮助我获得解决方案？

Answer 1

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

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 and .EnableEvents property 等应用程序环境设置。对于非常大的数据块，构建目标数组并将已解析的数据转储回工作表 en masse 也会有所帮助。您应该能够相当容易地格式化目标 table 的百分比和任何视觉美化。

转置满足条件的行中的值

Transpose values from a row where criteria are met

arrays

excel

lookup-tables

excel-formula