Excel VBAdynamic代码重复失败
这个代码有点复杂，但是它的问题是它运行的第二次和第三次，它会从“Base434”工作表上丢失信息。 我尝试了一个快速的方法来添加“Range（”A1“）。select以前突出显示的任何东西都不能抛弃它，但是它保持第20行是列”T“。希望有人能find我的错误，我只是无法分类。
本质上，这段代码在一个名为“Base434”的导入工作表上对数据的设置字段进行sorting，将特定字段复制到具有一些embedded式公式的另一个页面，然后检查工作表“NoStdHC”是否存在。 如果没有，它将创build所述工作表并添加标题。 然后移到名为“Base434”的过滤工作表，并复制该工作表中的所有可见单元格。 然后将它们粘贴到“NoStdHC”列A的第一个可用单元格中。 我的问题是运行后，它拒绝复制已导入的下一个“Base434”表最后一列。 任何人都可以在我的代码中find错误？ 是的，我知道如果我在编码方面做得更好，可以将其中的许多内容压缩出来，但是我更愿意理解代码在做什么，这就是为什么我这样写的原因。
Sub NoStdHC() ' ' NoStdHC Macro created by ' ' Application.ScreenUpdating = False Sheets("Base434").Select LastRow = Cells(Rows.Count, "B").End(xlUp).Row ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=15 ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=10 ActiveSheet.Range("A1:T" & LastRow).AutoFilter Field:=10, Criteria1:="<=.5", _ Operator:=xlAnd Columns(11).Cells.SpecialCells(xlCellTypeVisible).Cells(2).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Processing").Select Range("AC1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("C5").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=COUNTA(C[26])" Range("e5").Select ActiveCell.FormulaR1C1 = "=SUM(C[24])" Range("C8").Select Sheets("Base434").Select Dim wsTest As Worksheet Const strSheetName As String = "PR0OnStd" Set wsTest = Nothing On Error Resume Next Set wsTest = ActiveWorkbook.Worksheets(strSheetName) On Error GoTo 0 If wsTest Is Nothing Then Worksheets.Add.Name = strSheetName Sheets("Base434").Select Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Selection.Copy Sheets("PR0OnStd").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.Columns.AutoFit Range("A2").Select With ActiveWindow .SplitColumn = 0 .SplitRow = 1 End With ActiveWindow.FreezePanes = True End If Sheets("Base434").Select Range("a1").Select Columns(1).Cells.SpecialCells(xlCellTypeVisible).Cells(2).Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Selection.Copy Sheets("PR0OnStd").Select LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A" & LastRow).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.ScreenUpdating = True End Sub' 如果你想写代码，你可以很容易地理解你不会写这样的代码：
Sheets("Base434").Select Range("A1").Select Range(Selection, Selection.End(xlToRight)).Select Selection.Copy
这就是你的代码所说的，翻译成简单的语言：
Look at sheet "Base434" Look at cell A1 (implied: in that sheet) Look at what you are looking at and extend your view to the last ??? right (This is where the mistake is) Copy what you are looking at.
现在，当然，如果你想明白这一切的目标是什么，你可能会这样expression这个想法：
Copy the cells in Row 1 of Sheet "Base434" from A1 to the end of the row.
用这种方法你最终会得到这样的代码：
Dim RangeToCopy As Range Dim Cl As Long ' the last used column With Worksheets("Base434") Cl = .Cells(1, .Columns.Count).End(xlToLeft).Column Set RangeToCopy = .Range(.Cells(1, 1), .Cells(1, Cl)) End With MsgBox "Range to copy = " & RangeToCopy.Address RangeToCopy.Copy
你会说这个代码比你的版本更难阅读和理解吗？ 那么，它有三个好处，即使是。 一，它没有你的错。 二，从来没有想要犯错误，你的做法。 三，不pipe它可能包含的错误是容易find并且快速消除的。
而且，运行速度更快。
正如@ASH所评论的，尽可能避免使用Select/Activate/ActiveCell 。 范围应该使用表格名称进行限定。 With...End With结构实现这两个目标。 With语句允许您在指定的对象上执行一系列语句，而无需重新对象的名称。
缩进使得代码更易于阅读和理解。
考虑到上述内容，我认为这个代码是可以理解的
Sub NoStdHC() Dim LastRow As Long Dim sht As Worksheet Application.ScreenUpdating = False With Sheets("Base434") LastRow = .Cells(Rows.Count, "B").End(xlUp).Row .Range("A1:T" & LastRow).AutoFilter Field:=10, Criteria1:="<=.5" .Range(.Cells(2, 11), .Cells(LastRow, 11)).Copy End With With Sheets("Processing") .Range("AC1").PasteSpecial xlPasteValues Application.CutCopyMode = False .Range("C5").FormulaR1C1 = "=COUNTA(C[26])" .Range("E5").FormulaR1C1 = "=SUM(C[24])" End With Dim wsTest As Worksheet Const strSheetName As String = "PR0OnStd" 'Loop through sheets to find strSheetName 'if not found, then wsTest will be Nothing For Each sht In ThisWorkbook.Sheets If sht.Name = strSheetName Then Set wsTest = ActiveWorkbook.Worksheets(strSheetName) Exit For End If Next If wsTest Is Nothing Then 'Add the sheet, set up headings, column widths and frozen pane Worksheets.Add.Name = strSheetName With Sheets("Base434") .Range("A1", .Range("A1").End(xlToRight)).Copy End With With Sheets("PR0OnStd") .Range("A1").PasteSpecial xlPasteValues .UsedRange.Columns.AutoFit End With With ActiveWindow .SplitColumn = 0 .SplitRow = 1 .FreezePanes = True End With End If With Sheets("Base434") .Range(.Cells(2, 1), .Cells(LastRow, 2).End(xlToRight)).Copy End With With Sheets("PR0OnStd") LastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1 .Range("A" & LastRow).PasteSpecial xlPasteValues Application.CutCopyMode = False End With Application.ScreenUpdating = True
结束小组