根据标题引用，根据同一行中另一个单元格的值清除单元格的内容

Question

我是 VBA 领域的新手，无法完全理解我想要创建的这个宏。

基本上，我有一个月度数据集，但数据不完善。我经常需要根据另一个单元格的值清除一个单元格的多余数据值。

复杂的部分是数据将每周更换一次，唯一静态的就是包含的列标题。

例如，A 到 E 列有标题 Company1、Company2、Company3 等。 Q 到 U 列有标题 Product1、Product2、Product3 等。

产品列将包含公司名称作为值（通常不止一个，以逗号分隔），如果任何产品列中均未出现公司名称，则在同一行的单元格中显示该名称公司的栏目应该被清除。

因此，如果 Q4:U4 不包含“Product1”作为值，则应清除 A4（产品 1 列，第 4 行）处的值。

任何有关如何解决此问题的见解将不胜感激！

编辑

示例数据的屏幕截图：

Example 2

Answer 1

试试这个。在 VBA 编辑器中创建一个新模块并复制下面的代码...

Public Sub ProcessData()
    Dim objCompanyRange As Range, objProductRange As Range, objCompanyCell As Range
    Dim strCompany As String, objThisProductRange As Range, rngFrom As Range
    Dim rngTo As Range, objFindResult As Range, lngLastRow As Long

    On Error Resume Next

    ' Get the range for the company data.
    Set objCompanyRange = Application.InputBox("Please select the COMPANY data range, including headers ...", "Company Data", , , , , , 8)
    If Err.Description <> "" Then Exit Sub

    ' Get the range for the product data.
    Set objProductRange = Application.InputBox("Please select the PRODUCT data range, including headers ...", "Product Data", , , , , , 8)
    If Err.Description <> "" Then Exit Sub

    On Error GoTo 0

    For Each objCompanyCell In objCompanyRange
        ' We want the headers in the range but want to skip processing the first row.
        If objCompanyCell.Row > objCompanyRange.Cells(1, 1).Row Then
            ' This is the only contentious line for me.  If your headers are specified as you had in your
            ' example, i.e. "Group: Company1" then the below will work.  If that was a mocked example that
            ' was not 100% accurate, the below line will need to change.  It is currently splitting the header
            ' by a colon and only storing the right hand side as the company.
            strCompany = Trim(Split(objCompanyRange.Cells(1, objCompanyCell.Column).Text, ":")(1))

            ' Only reset objThisProductRange if the row has changed, otherwise we use the same set of
            ' products we used last time.
            If objCompanyCell.Row <> lngLastRow Then
                ' Determine the range for the product data given the current row being processed
                With objProductRange.Worksheet
                    Set rngFrom = .Range(.Cells(objCompanyCell.Row, objProductRange.Cells(1, 1).Column).Address)
                    Set rngTo = rngFrom.Offset(0, objProductRange.Columns.Count - 1)
                End With

                Set objThisProductRange = Range(rngFrom.Address & ":" & rngTo.Address)
            End If

            ' Find the company name within the current row of Product data.
            Set objFindResult = objThisProductRange.Find(strCompany, MatchCase:=False)

            ' Clear the cell if nothing was found.
            If objFindResult Is Nothing Then
                objCompanyCell.ClearContents
            End If
        End If

        lngLastRow = objCompanyCell.Row
    Next
End Sub

...现在观看下面的动画 GIF 以了解您如何启动它以及生成的输出。

如果每次选择数据集都会给您带来麻烦，那么您可以随意对其进行硬编码或使用您自己的确定方法。这是最简单的方法，因为我不知道你可能想怎么做。

希望这是您所追求的。如果您有任何问题，请务必阅读代码中的 cmets。