Question

我在c6：H200范围内的一张表（InputSheet）上有一个名称列表。此范围内的名称每月更改两次。将InputSheet中的名称组与e2：e50范围内的另一个工作表（NameList）上的名称列表进行比较。对于NameList上找到的每个名称，我想删除InputSheet上的名称。我是vba的新手，但已经编写了这段代码而且它无法运行（运行时错误）。谢谢你的帮助！

 Sub RemoveNonWords()

Dim datasheet As Worksheet
Dim cl As Range

Set wordrange = InputSheet.Range("C6:h200")
Set datasheet = NameList.Range("E1:E50").Value   

  For Each cl In wordrange
    If cl = datasheet Then
       cl.Selection.ClearContents
    End If
  Next

Range("A6").Select

End Sub

Answer 1

您发布的代码存在很多问题。我想最后，这是你正在寻找的，代码为了清晰起见：

Sub tgr()

    Dim wb As Workbook
    Dim wsInput As Worksheet
    Dim wsNames As Worksheet
    Dim rInputData As Range
    Dim rNameList As Range
    Dim DataCell As Range
    Dim rClear As Range
    Dim lRow As Long

    Set wb = ActiveWorkbook
    Set wsInput = wb.Sheets("InputSheet")   'Change to the actual sheet name of your input sheet
    Set wsNames = wb.Sheets("NameList")     'Change to the actual sheet name of your name list sheet

    'Get last used row of the C:H columns in wsInput
    With wsInput.Range("C:H")
        lRow = .Find("*", .Cells(1), , , , xlPrevious).Row
        If lRow < 6 Then Exit Sub   'No data
    End With

    'Use the last used row to define your inputdata range, this was hardcoded to C6:H200 in your question
    Set rInputData = wsInput.Range("C6:H" & lRow)

    'Define the namelist range using all populated cells in column E of wsNames, this was hardcoded to E2:E50 in your question
    Set rNameList = wsNames.Range("E2", wsNames.Cells(wsNames.Rows.Count, "E").End(xlUp))
    If rNameList.Row < 2 Then Exit Sub  'No data

    'Data has been found and ranges assigned
    'Now loop through every cell in rInputData
    For Each DataCell In rInputData.Cells
        'Check if the cell being looked at exists in the NameList range
        If WorksheetFunction.CountIf(rNameList, DataCell.Value) > 0 Then
            'Found to exist, add the cell to the Clear Range
            If rClear Is Nothing Then
                Set rClear = DataCell   'First matching cell added
            Else
                Set rClear = Union(rClear, DataCell)    'All subsequent matching cells added
            End If
        End If
    Next DataCell

    'Test if there were any matches and if so clear their contents
    If Not rClear Is Nothing Then rClear.ClearContents

End Sub

在Sheet1上的单词列表中搜索Sheet1中的单词，如果匹配则单击Sheet1上的单词

1 个答案: