我怎样才能缩短这个VBA代码？ 复制和粘贴单元格

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

作为一个教育练习，谁能告诉我怎样才能缩短呢？

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 

结束小组

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 

使用拆分string的变体

 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 

这一次可能没有必要，但正如你所说，你希望有一个教育的excersise，你可以创build一个程序，只是为了复制单元格的值从一个到另一个。 它可能是这样的：

 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