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动画，以了解如何启动它以及产生的输出。

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

希望这就是您的追求。如有任何疑问，请务必阅读代码中的注释。

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

1 个答案: