Fehlerbehebung Excel VBA-Code

Question

Der Sinn dieses Codes besteht darin, Benutzereingaben von einem "Remove Flags" -Tab zu nehmen, in dem der Benutzer eine Artikelnummer platziert und zu welchem ​​Programm er gehört, filtert die Registerkarte "Master List" nach der Artikelnummer und das Programm, dann den Namen des Flags mit der Spalte übereinstimmen und das Flag löschen. Der Offset funktioniert jedoch nicht. Es löscht stattdessen den Header. Wenn ich durchgehe, funktioniert alles gut, bis die Zeile, die ich mit '*******' markiert habe.

Ich bin ziemlich neu in VBA und bin Autodidakt, so dass jede und jede Hilfe sehr geschätzt wird. Vielen Dank für Ihre Zeit.

BEARBEITEN: "On Error Resume Next" entfernt und einige Rechtschreibfehler behoben. Aktuelle Ausgabe ist mit RNG> 1 Reihen nicht mit, wenn es gefiltert und hat auf jeden Fall zwei Reihen (eine Zeile ist die Kopfzeile, eine Zeile ist die zurückgegebenen Daten.)

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

Manchmal ist es einfacher, nur die Zeilen und Spalten zu durchlaufen. So etwas wie die folgenden:

Ersetzen Sie alles zwischen:

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

mit:

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

Als @Zerk vorgeschlagen, stellen Sie zuerst zwei Arbeitsblatt Variablen an der Spitze der Code:

Dim wsMaster As Worksheet 
Dim wsRemoveFlags As Worksheet 

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

Dann alle anderen Instanzen von Worksheets ersetzen ("Master List") mit wsMaster und Arbeitsblätter ("entfernen Flags") mit wsRemoveFlags.