Question

对于我粘贴到新工作表的每个单元格，下面的许多代码都是重复的。

作为一项教育活动，任何人都可以告诉我如何缩短它吗？

Sub RowForTracker()

Worksheets.Add(After:=Worksheets(1)).Name = "ForTracker"

Sheets("Summary").Range("C2").Copy
Sheets("ForTracker").Range("A1").PasteSpecial Paste:=xlPasteValues

Sheets("Summary").Range("C6").Copy
Sheets("ForTracker").Range("B1").PasteSpecial Paste:=xlPasteValues

Sheets("Summary").Range("C8").Copy
Sheets("ForTracker").Range("C1").PasteSpecial Paste:=xlPasteValues

Sheets("Summary").Range("C3").Copy
Sheets("ForTracker").Range("D1").PasteSpecial Paste:=xlPasteValues

Sheets("Summary").Range("H8").Copy
Sheets("ForTracker").Range("E1").PasteSpecial Paste:=xlPasteValues

Sheets("Summary").Range("H9").Copy
Sheets("ForTracker").Range("F1").PasteSpecial Paste:=xlPasteValues

Sheets("Summary").Range("C5").Copy
Sheets("ForTracker").Range("G1").PasteSpecial Paste:=xlPasteValues

End Sub

Answer 1

另外一个例子，你可以如何实现CopyPaste

Sub test1()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    With T
        .[A1] = S.[C2]
        .[B1] = S.[C6]
        .[C1] = S.[C8]
        .[D1] = S.[C3]
        .[E1] = S.[H8]
        .[F1] = S.[H9]
        .[G1] = S.[C5]
    End With
End Sub

使用数组的变体

Sub test2()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    Dim CopyPaste, x%
    x = 0
    With S
        CopyPaste = Array(.[C2], .[C6], .[C8], .[C3], .[H8], .[H9], .[C5])
    End With
    For Each oCell In T.[A1:G1]
        oCell.Value = CopyPaste(x): x = x + 1
    Next
End Sub

使用拆分字符串的变体

Sub test3()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    Dim CopyPaste$
    With S
        CopyPaste = .[C2] & "|" & .[C6] & "|" & .[C8] & "|" & .[C3] & "|" & .[H8] & "|" & .[H9] & "|" & .[C5]
    End With
    T.[A1:G1] = Split(CopyPaste, "|")
End Sub

变体使用字典

Sub test4()
    Dim S As Worksheet: Set S = Sheets("Summary")
    Dim T As Worksheet: Set T = Sheets("ForTracker")
    Dim CopyPaste As Object: Set CopyPaste = CreateObject("Scripting.Dictionary")
    Dim oCell As Range, Key As Variant, x%
    x = 1
    For Each oCell In S.[C2,C6,C8,C3,H8,H9,C5]
        CopyPaste.Add x, oCell.Value: x = x + 1
    Next
    x = 0
    For Each Key In CopyPaste
        T.[A1].Offset(, x).Value = CopyPaste(Key)
        x = x + 1
    Next
End Sub

Answer 2

好吧，如果你想简化它，你可以这样做：

Sub Main()

    Dim wsS As Worksheet
    Dim wsT As Worksheet

    Set wsS = Sheets("Summary")
    Set wsT = Sheets("ForTracker")

    wsT.Range("A1").Value = wsS.Range("C2").Value
    wsT.Range("B1").Value = wsS.Range("C6").Value
    wsT.Range("C1").Value = wsS.Range("C8").Value
    wsT.Range("D1").Value = wsS.Range("C3").Value
    wsT.Range("E1").Value = wsS.Range("H8").Value
    wsT.Range("F1").Value = wsS.Range("H9").Value
    wsT.Range("G1").Value = wsS.Range("C5").Value

End Sub

这次可能没有必要，但正如你所说，你希望有一个教育方法，你可以创建一个程序，只是为了将单元格值从一个复制到另一个。它看起来像这样：

Sub CopyValue(CopyFrom As Range, PasteTo As Range)
    PasteTo.Value = CopyFrom.Value
End Sub

你会这样称呼它：

CopyValue wsS.Range("C2"), wsT.Range("A1")

或者，如果你想要更清楚，就像这样：

CopyValue CopyFrom:=wsS.Range("C2"), PasteTo:=wsT.Range("A1")

Answer 3

单程

Dim target As Range, item As Range, i As Long
With Worksheets.Add(After:=Worksheets(1))
    .Name = "ForTracker"
    Set target = .Range("A1")
End With

For Each item In Sheets("summary").Range("C2,C6,C8,C3,H8,H9,C5")
    target.Offset(0, i).value = item.value
    i = i + 1
Next

Answer 4

试试这个：

        Sub RowForTracker()

            Dim wksSummary          As Worksheet
            Dim wksForTracker       As Worksheet

            Worksheets.Add(After:=Worksheets(1)).Name = "ForTracker"
            Set wksSummary = Sheets("Summary")
            Set wksForTracker = Sheets("ForTracker")

            With wksForTracker
                .Range("A1").Value = wksSummary.Range("C2").Value
                .Range("B1").Value = wksSummary.Range("C6").Value
                .Range("C1").Value = wksSummary.Range("C8").Value
                .Range("D1").Value = wksSummary.Range("C3").Value
                .Range("E1").Value = wksSummary.Range("H8").Value
                .Range("F1").Value = wksSummary.Range("H9").Value
                .Range("G1").Value = wksSummary.Range("C5").Value
            End With

        End Sub

如何缩短此VBA代码？复制和粘贴单元格

4 个答案: