如何摆脱选择和复制并编写更好的代码?

时间:2014-06-06 13:25:32

标签: excel-vba vba excel

你能解释一下我如何摆脱在这段代码中使用select和copy吗?我想让它尽可能高效地运行,无需更新屏幕。我知道我可以设置screenupdating = false,但我更喜欢让代码写得更好!

Dim i As Integer

        For i = 4 To 501

            Sheets("Repository").Range("B" & i).Copy
            Sheets("Input").Activate
            Sheets("Input").Range("M13").Select
            Selection.PasteSpecial Paste:=xlPasteValues

            Sheets("Input").Range("M21").Copy
            Sheets("Repository").Activate
            Sheets("Repository").Range("E" & i).Select
            Selection.PasteSpecial Paste:=xlPasteValues


            Sheets("Input").Range("U12").Copy
            Sheets("Repository").Activate
            Sheets("Repository").Range("C" & i).Select
            Selection.PasteSpecial Paste:=xlPasteValues

            Sheets("Input").Range("V12").Copy
            Sheets("Repository").Activate
            Sheets("Repository").Range("D" & i).Select
            Selection.PasteSpecial Paste:=xlPasteValues

        Next i

非常感谢。

3 个答案:

答案 0 :(得分:0)

你可以消除很多激活和选择。这是我写它的方式:

        Application.ScreenUpdating = False
        For i = 4 To 501

            Sheets("Repository").Range("B" & i).Copy
            Sheets("Input").Range("M13").PasteSpecial Paste:=xlPasteValues

            Sheets("Input").Range("M21").Copy
            Sheets("Repository").Range("E" & i).PasteSpecial Paste:=xlPasteValues


            Sheets("Input").Range("U12").Copy
            Sheets("Repository").Range("C" & i).PasteSpecial Paste:=xlPasteValues

            Sheets("Input").Range("V12").Copy
            Sheets("Repository").Range("D" & i).PasteSpecial Paste:=xlPasteValues

        Next i
        Application.ScreenUpdating = True

我仍然建议将screenupdate设置为false。如果它不需要向用户显示它正在采取的每个动作,它将运行得更快。

答案 1 :(得分:0)

首先,您不需要选择/激活/复制...您可以简单地将值从一个单元格分配给另一个单元格(使用/不使用变量)。我会这样做:

Sub test()

Dim i As Long 'Integer has a strict limit
Dim j As Integer
Dim RepositoryWs As Worksheet
Dim InputWs As Worksheet
Dim destinationCell(1 To 4) As Range
Dim sourceCell(1 To 4) As Range

Set RepositoryWs = Worksheets("Repository")
Set InputWs = Worksheets("Input")

'Static ranges
With InputWs

    Set destinationCell(1) = .Range("M13")
    Set sourceCell(2) = .Range("M21")
    Set sourceCell(3) = .Range("U12")
    Set sourceCell(4) = .Range("V12")

End With

For i = 4 To RepositoryWs.Range("B4").End(xlDown).Row 'Not hardcoded -> it works if you'll have more data on Repository sheet

    'Dynamic ranges
    With RepositoryWs

        Set sourceCell(1) = .Range("B" & i)
        Set destinationCell(2) = .Range("E" & i)
        Set destinationCell(3) = .Range("C" & i)
        Set destinationCell(4) = .Range("D" & i)

    End With

    For j = 1 To 4

        destinationCell(j).Value = sourceCell(j).Value

    Next j

Next i

End Sub

答案 2 :(得分:0)

如果您只将值从一个单元格移动到另一个单元格,则无需复制/粘贴。如果你必须复制很多格式,那么可能需要它。这应该完成同样的事情,在我看来,这是最简单的方法 -

Dim wsRepository as Worksheet
Set wsRepository = ThisWorkbook.Sheets("Repository")

Dim wsInput as Worksheet
Set wsInput = ThisWorkbook.Sheets("Input")

Dim i As Integer
For i = 4 To 501

    wsInput.Range("M13") = wsRepository.Range("B" & i)

    wsRepository.Range("E" & i) = wsInput.Range("M21")

    wsRepository.Range("C" & i) = wsInput.Range("U12")

    wsRepository.Range("D" & i) = wsInput.Range("V12")

Next i