Excel VBA動的コード繰り返し失敗

Question

このコードは少し複雑ですが、問題は2回目と3回目に実行され、情報を取得する「Base434」ワークシートの列が失われ始めます。私は "Range（" A1 "）を追加する簡単な修正を試みました。以前に強調表示されたものはそれを投げ捨てることはできませんでしたが、列" T "である20番目の行を切り捨てるようにします。

本質的に、このコードは、「Base434」という名前のインポートされたワークシートのセットフィールドをソートし、特定のフィールドを別の埋め込み式を持つ別のページにコピーして確認しますワークシート "NoStdHC"が存在する場合は、ワークシートを作成してヘッダーを追加し、 "Base434"というフィルタを適用したワークシートに移動し、そのワークシート内のすべての可視セルをコピーします。 "NoStdHC"の列Aの使用可能なセル。私の問題は、インポートされた次の "Base434"シートの最後の列をコピーすることを拒否すると、これを実行した後です。 de？はい、私はコーディングがうまくいけば、これが凝縮される可能性があることはよく知っていますが、コードが何をしているのかを理解することが望ましいでしょう。

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' 

Answer 1

あなたが簡単にあなたがこのようなコードを記述しないと理解することができ、書き込みコードを書きたい場合： - ：

-

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. 

は今、確かに、あなたは多少このような考え方を表現かもしれませんことを目指していますあなたはこのようなコードで終わるだろうこの種のアプローチで

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 

あなたは、このコードは、あなたのバージョンよりも読みやすく、理解しにくいと言うだろうか？まあ、たとえそれがあっても3つの利点があります。 1つは、あなたの欠点がありません。 2つ目は、あなたのアプローチがした間違いをしたくないということに決して近づけませんでした。 3つは、それがまだ含まれている可能性のあるエラーであれば、簡単に見つけ出して排除することができます。

さらに、より速く実行されます。

Answer 2

@ A.S.Hがコメントしたように、可能であれば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 

End Subの