多次运行编码会删除相关数据



我的代码有很大的弱点。 如果我多次运行它,它会删除所需的数据,因为它会根据需要删除列。 第一次执行会格式化完美运行的 SAP 报告。如果它再次运行,我不知道如何阻止它删除列。请问有人可以看看并提出建议吗? 谢谢

Sub Format_ZM27KG()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim X1 As Long
    Dim LookUpTable1 As Variant
    Dim LookUpValue1 As Long
    Dim LastRow1 As Long
    Dim vAnswer1 As String
    Dim X2 As Long
    Dim vAnswer2 As Long
    Dim LastRow2 As Long
    Dim vAnswer3 As Long
    Set ws1 = ActiveWorkbook.Worksheets("Format KG")
    Set ws2 = ActiveWorkbook.Worksheets("LookUp")
    Application.ScreenUpdating = False
    Dim A1 As Long
    For A1 = 1 To 8 Step 1
    ws1.Rows(1).EntireRow.Delete
    Next A1
    Dim LR3 As Long
    Dim i2 As Long
    With ws1
        LR3 = .Range("C" & .Rows.Count).End(xlUp).Row
        For i2 = LR3 To 2 Step -1
        If Not IsNumeric(.Range("C" & i2).Value) Or .Range("C" & i2).Value = "" Then .Rows(i2).Delete
        Next i2
    End With
    'Delete columns on tab format cases
    ws1.Columns("A:B").EntireColumn.Delete
    ws1.Columns("B:D").EntireColumn.Delete
    ws1.Columns("C:M").EntireColumn.Delete
    ws1.Columns("N").EntireColumn.Delete
    ws1.Columns("C").EntireColumn.Delete
    ws1.Cells(1, "N").Value = "Category"
    LastRow1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row
    On Error Resume Next
    LookUpTable1 = ws2.Range("A1:C500")
    For X1 = 2 To LastRow1
    LookUpValue1 = Cells(X1, "A").Value
    vAnswer1 = Application.WorksheetFunction.VLookup(LookUpValue1, LookUpTable1, 3, False)
    ws1.Cells(X1, "N").Value = vAnswer1
    Next X1
    ws1.Columns("A:AL").AutoFit
    ws1.Rows(1).HorizontalAlignment = xlCenter
    ws1.Range("A1").Select
    Application.ScreenUpdating = True
End Sub

如果您不希望删除列,则需要添加 if 语句来检查是否确实需要删除列。您可以通过从代码中更改它来执行此操作:

'Delete columns on tab format cases
ws1.Columns("A:B").EntireColumn.Delete
ws1.Columns("B:D").EntireColumn.Delete
ws1.Columns("C:M").EntireColumn.Delete
ws1.Columns("N").EntireColumn.Delete
ws1.Columns("C").EntireColumn.Delete

将其替换为以下块:

'Delete columns if the column header for column "N" is not "category". 
If ws1.Cells(1, "N").Value <> "Category" then 
    ws1.Columns("A:B").EntireColumn.Delete
    ws1.Columns("B:D").EntireColumn.Delete
    ws1.Columns("C:M").EntireColumn.Delete
    ws1.Columns("N").EntireColumn.Delete
    ws1.Columns("C").EntireColumn.Delete
end if 

最新更新