Устранение неисправностей Код Excel VBA

Question

Точка этого кода предназначена для ввода пользовательских входов с вкладки «Удалить флаги», в которой пользователь ставит номер позиции и какую программу она принадлежит, фильтрует вкладку «Главный список» по номеру позиции и программу, затем сопоставьте имя флага столбцу и удалите флаг. Однако смещение не работает. Вместо этого он удаляет заголовок. Когда я прохожу через него, все работает нормально, пока строка, отмеченная символом «*******».

Я довольно новичок в VBA, и я сам преподаю, поэтому всякая помощь очень ценится. Спасибо вам большое за ваше время.

РЕДАКТИРОВАТЬ: Убрано «При повторном возобновлении поиска дальше» и исправлены некоторые орфографические ошибки. Текущая проблема связана с 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

Иногда проще просто прокручивать строки и столбцы. Что-то вроде следующего:

Заменить все между:

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 

Answer 2

Как предложено @Zerk, первый набор два рабочего листа переменные в верхней части коды:

Dim wsMaster As Worksheet 
Dim wsRemoveFlags As Worksheet 

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

Затем замените все другие экземпляры Таблиц («Master List») с wsMaster и Таблицами («Удалить флаги») с wsRemoveFlags.