Question

我有一些可以正常工作的VBA代码，但是我试图通过丢失选择命令来改进我的代码。我得知这不是最佳做法。起作用的（旧）代码如下：

With Sheets("Data")
        RowCount = .Cells(.Rows.Count, "B").End(xlUp).Row

        For i = 1 To RowCount

        Range("B1").Offset(1, 0).Select

If ActiveCell.Offset(0, -1).Value = 2 And ActiveCell.Value = sPeril Then

    ActiveSheet.Cells.Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy
Sheets("DynamicCharts").Select
Sheets("DynamicCharts").Range("E" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Data").Select

End If

next i

End With

该代码在使用偏移单元的纸张复制和粘贴之间切换。香港专业教育学院试图用WITH命令及其在paste命令上的调试来更改此设置。

With Sheets("Data")
    RowCount = .Cells(.Rows.Count, "B").End(xlUp).Row

    For i = 1 To RowCount

    Range("B1").Offset(1, 0).Select

    If ActiveCell.Offset(0, -1).Value = 1 And ActiveCell.Value = sPeril Then

        ActiveSheet.Cells.Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        With Sheets("DynamicCharts")
        .Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
        'Sheets("EDM Data").Select

    End If

next i

End With

对此有任何帮助。

预先感谢

Answer 1

请尝试一下-完全不需要Select。我们也可以摆脱Copy/Paste，但我需要知道您要带些什么（也许是特定格式的？）。提出问题时（例如sPeril等），请包括更多代码：

Dim destrow As Long, lastcol As Long

With Sheets("Data")
    RowCount = .Cells(.Rows.Count, "B").End(xlUp).Row

    For i = 2 To RowCount

        If Range("B" & i).Offset(0, -1).Value = 2 And Range("B" & i).Value = sPeril Then

            destrow = Sheets("DynamicCharts").Cells(Sheets("DynamicCharts").Rows.Count, "E").End(xlUp).Row
            lastcol = Sheets("Data").Cells(i, Sheets("Data").Columns.Count).End(xlToLeft).Column

            Sheets("Data").Range(Sheets("Data").Cells(i, 2), Sheets("Data").Cells(i, lastcol)).Copy
            Sheets("DynamicCharts").Range("E" & destrow + 1).PasteSpecial

        End If

    Next i

End With

Answer 2

您的代码但有一个简单的修复程序，只需查看注释即可。请注意，我将peril设置为2只是为了使代码处于这种状态。

 Sub test2()
    With Sheets("sheet1")
        RowCount = .Cells(.Rows.Count, "B").End(xlUp).Row

        For i = 1 To RowCount

        Range("B1").Offset(1, 0).Select
        sPeril = 2
        If ActiveCell.Offset(0, -1).Value = 1 And ActiveCell.Value = sPeril Then

            ActiveSheet.Cells.Range(Selection, Selection.End(xlToRight)).Select
            Selection.Copy
            With Sheets("DynamicCharts")
            'remove selection on this line.
            .Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End With
            'Sheets("EDM Data").Select

        End If

    Next i

    End With
    End Sub

VBA偏移和粘贴

2 个答案: