Question

此代码的要点是从＆＃34;删除标志＆＃34;中获取用户输入。用户放置项目编号及其所属程序的选项卡，过滤＆＃34;主列表＆＃34;按项目编号和程序选项卡，然后将该标志的名称与该列匹配并删除该标志。但是偏移不起作用。而是删除标题。当我单步执行它时，一切正常，直到我标记为＆＃39; *******。

我对VBA相当新，并且自学成才，所以非常感谢任何和所有的帮助。非常感谢您的宝贵时间。

编辑：已删除＆＃34;出错时继续下一步＆＃34;并修正了一些拼写错误。当前问题是rng在过滤时没有> 1行，并且肯定有两行（一行是标题，一行是返回的数据。）

Sub RemoveFlag()
Dim cel As Range
Dim rg As Range
Dim d As Double
Dim i As Integer
Dim m As Integer
Dim n As Integer
Dim rng As Range
Dim wsMaster As Worksheet
Dim wsFlag As Worksheet
Set wsMaster = Worksheets("Master List")
Set wsFlag = Worksheets("Remove Flags")
i = 6

'If there is no data. Do nothing.
If wsFlag.Range("C6") = "" Then
    wsFlag.Activate
Else
    Application.ScreenUpdating = False

'Add Leading zeroes
wsFlag.Activate
Set rg = Range("C6")
Set rg = Range(rg, rg.Worksheet.Cells(Rows.Count, rg.Column).End(xlUp))
rg.NumberFormat = "@"
For Each cel In rg.Cells
If IsNumeric(cel.Value) Then
    d = Val(cel.Value)
    cel.Value = Format(d, "000000000000000000") 'Eighteen digit number
End If
Next

'Clear all the filters on the Master List tab.
    wsMaster.Activate
If wsMaster.AutoFilterMode = True Then
    wsMaster.AutoFilterMode = False
End If

'Loop through all lines of data
    Do While wsFlag.Cells(i, 3).Value <> ""
'Filter by the SKU number
wsMaster.Range("A1").AutoFilter Field:=4, Criteria1:=wsFlag.Cells(i, 3).Value
'Filter by the Program
    wsMaster.Range("A1").AutoFilter Field:=2, Criteria1:=wsFlag.Cells(i, 2).Value
'If the filter is not empty find the column of the flag
Set rng = wsMaster.UsedRange.SpecialCells(xlCellTypeVisible)

If (rng.Rows.Count > 1) Then
    wsMaster.Range("A1:Z1").Find(wsFlag.Cells(i, 4), LookIn:=xlValues).Activate
    n = ActiveCell.Column
    Sheets("Master List").Range.Offset(1, 0).SpecialCells(xlCellTypeVisible).Select
    m = ActiveCell.Row
    Cells(m, n) = ""
    wsFlag.Activate
    wsFlag.Range(Cells(i, 2), Cells(i, 4)).ClearContents
Else
    wsFlag.Activate
    wsFlag.Range(Cells(i, 2), Cells(i, 4)).Copy
    wsFlag.Range("F4").End(xlDown).Offset(1, 0).Activate
    ActiveCell.PasteSpecial Paste:=xlPasteValues
    wsFlag.Range(Cells(i, 2), Cells(i, 4)).ClearContents
End If
    wsMaster.Activate
    wsMaster.AutoFilterMode = False
i = i + 1
Loop

'Make sure the entire Master List tab is not highlighted and pull the 'highlighted cell' to A1 in both tabs.
    wsMaster.Activate
    wsMaster.Range("A1").Activate

wsFlag.Activate
Range("A1").Activate

'Unfreeze the screen
Application.ScreenUpdating = True

End If
End Sub

Answer 1

正如@Zerk建议的那样，首先在代码顶部设置两个Worksheet变量：

Dim wsMaster As Worksheet
Dim wsRemoveFlags As Worksheet

Set wsMaster = Worksheets("Master List")
Set wsRemoveFlags = Worksheets("Remove Flags")

然后使用wsRemoveFlags替换wsMaster和工作表（＆＃34;删除标志＆＃34;）的所有其他工作表实例（＆＃34;主列表＆＃34;）。

Answer 2

有时，循环遍历行和列更容易。如下所示：

替换之间的所有内容：

Do While wsFlag.Cells(i, 3).Value <> ""
   ...
Loop

使用：

Do While wsFlag.Cells(i, 3).Value <> "" 
    Dim r As Long  ' Rows
    Dim c As Long  ' Columns
    Dim lastRow As Long
    Dim found As Boolean

    lastRow = wsMaster.Cells.SpecialCells(xlLastCell).Row
    found = False

    For r = 2 To lastRow ' Skipping Header Row
        ' Find Matching Program/SKU
        If wsMaster.Cells(r, 2).Value = wsFlag.Cells(i, 2).Value _
        And wsMaster.Cells(r, 3) = wsFlag.Cells(i, 3).Value Then
            ' Find Flag in Row
            For c = 1 To 26   ' Columns A to Z
                 If wsMaster.Cells(r, c) = wsFlag.Cells(i, 4) Then
                     ' Found Flag
                     wsMaster.Cells(r, c) = ""
                     found = True
                     Exit For ' if flag can be in more than one column, remove this.
                 End If
            Next 'c
        End If
    Next 'r

    If Not found Then
        ' Here is where you need to put code if Flag wsFlag.Cells(i, 4) not found.
    End If
Loop

Excel VBA代码疑难解答

2 个答案: