使用 INDEX-MATCH 获取简化图表

Question

我的问题是同一个项目有不同的参考代码（我们称之为“一般描述”）

根据我们销售的月份，我想要一张最终图表，根据我选择的月份显示摘要。就像下面的图表一样。

示例：

如果月份信息为0，则应给出参考之一，例如：

• 在“Z”的情况下，它应该选择参考“7777”，因为它有下个月/秒的信息（大于0）
• 在“a”的情况下，它应该选择参考“9999”，因为它没有未来信息（大于0），所以应该考虑最后一个（或最近的月份日期）的信息

我尝试使用 Index-Match 但找不到解决方案，而且我不太了解 vba 编程，这可能是解决这个问题的最佳方法

感谢您的帮助！

Answer 1

• 输出中的数据行位置与您的屏幕截图不完全相同，但您可以修改代码以重新定位它。

Option Explicit

Sub Demo()
    Dim i As Long, j As Long, iR As Long
    Dim arrData, rngData As Range
    Dim arrRes, arrLastMth, vRow, aRow, iCol, vKey
    Dim RowCnt As Long, ColCnt As Long
    Dim objDic As Object, objDic2 As Object
    Const START_COL = 3
    ' Load date
    Set rngData = ActiveSheet.Range("A3").CurrentRegion
    arrData = rngData.Value
    ' Locate target month
    iCol = Application.Match(Range("B1"), rngData.Rows(1), 0)
    If IsError(iCol) Then Exit Sub
    RowCnt = UBound(arrData)
    ColCnt = UBound(arrData, 2)
    ReDim arrLastMth(1 To RowCnt)
    ReDim arrRes(1 To RowCnt, 1 To 4)
    iR = 0
    Set objDic = CreateObject("scripting.dictionary")
    Set objDic2 = CreateObject("scripting.dictionary")
    ' Loop through data
    For i = LBound(arrData) + 1 To RowCnt
        If Val(arrData(i, iCol)) > 0 Then
            ' Get row if value > 0 (in target month col)
            iR = iR + 1
            arrRes(iR, 1) = arrData(i, 1)
            arrRes(iR, 2) = arrData(i, 2)
            arrRes(iR, 3) = arrData(i, 3)
            arrRes(iR, 4) = arrData(i, iCol)
            vKey = arrData(i, 1)
            If Not objDic2.exists(vKey) Then
                objDic2(vKey) = CStr(i)
            End If
        Else
            ' Get the last non-zero column for each row
            For j = ColCnt To START_COL Step -1
                If Val(arrData(i, j)) > 0 Then
                    arrLastMth(i) = j
                    Exit For
                End If
            Next
        End If
        ' Consolidate data by "General Desc"
        vKey = arrData(i, 1)
        If Not objDic2.exists(vKey) Then
            If objDic.exists(vKey) Then
                objDic(vKey) = objDic(vKey) & "," & CStr(i)
            Else
                objDic(vKey) = CStr(i)
            End If
        End If
    Next i
    ' Loop through data in Dict
    For Each vKey In objDic.Keys
        If Not objDic2.exists(vKey) Then
            aRow = Split(objDic(vKey), ",")
            i = 0: j = 0
            For Each vRow In aRow
                If arrLastMth(CLng(vRow)) > j Then
                    j = arrLastMth(CLng(vRow))
                    i = vRow
                End If
            Next
            ' Load data into output array
            iR = iR + 1
            arrRes(iR, 1) = arrData(i, 1)
            arrRes(iR, 2) = arrData(i, 2)
            arrRes(iR, 3) = arrData(i, 3)
            arrRes(iR, 4) = 0
        End If
    Next
    ' Write output to sheet
    Range("J4").Resize(iR, 4).Value = arrRes
End Sub