我被困在将数据传输到摘要表中。我有两张纸，想把它总结成第三张。
Sheet A
A B C D
1 Apple Orange Peach
2 Period Apple_Price Orange_price peach_price
3 1 5 5 3
4 2 6 4 9
5 3 7 7
Sheet B
A B C D
1 Apple Orange Peach
2 Period Apple_weight Orange_Weight peach_Weight
3 1 2.1 2.5 3.1
4 2 2.1 1.1 2.1
5 3 3.1 2.5
Summary sheet or sheet c (expected)
A B C D
1 Period Price Weight
2 Apple 1 5 2.1
3 2 6 2.1
4 3 7 3.1
5 Orange 1 5 2.5
6 2 4 1.1
7 Peach 1 3 3.1
8 2 9 2.1
9 3 7 2.5
我开始编写的代码有点像
For Each Name In Range("B1:D1")
' To copy each name in to first column of summary
Name.Cells.value.copy Worksheets("Summary").Offset(2,0)
' Now to copy a column from each sheet in front of corresponding name
Worksheets("SheetA").Range(Name & lastrow).Copy
Worksheets("summary").Range("a65536").End(xlUP).Offset(2,1)
'Now copy Periods and prices
Worksheets("SheetA").Range(Name & lastrow).Copy
Worksheets("summary").Range("a65536").End(xlUP).Offset(2,2)
'Now copy weights
Worksheets("SheetB").Range(Name & lastrow).Copy
Worksheets("summary").Range("a65536").End(xlUP).Offset(2,3)
Next
不幸的是我无法完成这项工作。我认为偏移存在一些问题。
答案 0 :(得分：1)
首先让我们看一下您现有的代码。
For Each Name In Range("B1:D1")
这假设有三个果实。添加第四个时，您必须在添加第五个时再次更新此代码。决定哪些水果有意义的人，维持宏观吗？如果没有，每次他们添加水果时，都必须要求更新宏。
确定未来可能允许的更改是平衡：
由于我对您的申请一无所知，我不是要求您同意我对准备的更改的评估。我请你考虑一下这个问题。您未检查的更改可能会导致损坏的摘要或崩溃的宏。这有多重要？您已检查但未处理的更改意味着在更新宏之前无法运行该宏。这有多重要？
Worksheets("summary").Range("a65536").End(xlUP).Offset(2,1)
在Excel 2007之前，工作表有65536行，因此单元格A65536位于列A的底部。自2007年以来编码的任何人都建议使用Cells(Rows.Count, 1)而不是Range("a65536")，因为它指定了底部当前版本的Excel的A列，无论它是什么。
我不喜欢Offset因为您必须执行心算来确定正在处理哪个单元格。如果句点数不总是正好为3，则必须对偏移行执行算术运算。也就是说：Offset(2, 1)必须由Offset(2+Period-1, 1)之类的内容替换。此外，您已从A列的底部开始，在执行偏移之前向上移动到列中的第一个单元格。
如果您的代码每天要执行数百万次，那么在运行时间内缩短一毫秒可能是合适的，但这是否合适？你编写这段代码需要多长时间（这无论如何都不起作用）以及代码的未来维护者要花多长时间才能理解你在做什么？我的建议是使代码简单易用，除非有一些压倒性的理由使它复杂且难以编写。
我的代码包含了节省时间的小技巧。这些都很容易实现，可以自动化。如果您需要10或20秒的时间来输入一个声明，以便为用户节省一小段时间，那么公司可以在几个月内获得投资回报（您的编码时间＆lt;用户的等待时间） 。此外，其中一些技巧使未来的维护更容易。对于必须在6或12个月内更新此宏的人来说，总是让生活更轻松，因为那个人可能就是你。
请不要使用“SheetA”或“SheetB”之类的名称。 “价格”和“重量”等名称会立即告诉您工作表的用途。有意义的名字变得如此简单。
我认为这是足够的批评。
仔细阅读此代码。有很多评论解释我正在尝试什么，但很少有评论解释每个声明的作用，所以如果你不知道也无法猜测你将不得不查看这些。使用F8逐个语句逐步执行宏语句。你了解每个陈述的作用以及我为什么要这样做吗？如果有必要，请回答问题，但是你越能自己解决问题，你就越快发展自己的技能。
Option Explicit
' Constants make maintenance so much easier:
' * You code is full of meaningful names rather than numbers whos purpose
' must be looked up.
' * If columns are rearranged or an extra heading line added to one of the
' worksheets, one change here and the problem is fixed.
Const ColPWPeriod As Long = 1
Const ColPWDataFirst As Long = 2
Const ColSummaryFruit As Long = 1
Const ColSummaryPeriod As Long = 2
Const ColSummaryPrice As Long = 3
Const ColSummaryWeight As Long = 4
Const ColSummaryLast As Long = 4
Const RowPWFruit As Long = 1
Const RowPWDataFirst As Long = 3
Sub CombineABIntoS()
Dim ColPriceLast As Long
Dim ColPWCrnt As Long
Dim ColWeightLast As Long
Dim FruitCrnt As String
Dim RowPriceLast As Long
Dim RowPWCrnt As Long
Dim RowSummaryCrnt As Long
Dim RowWeightLast As Long
Dim WshtPrice As Worksheet
Dim WshtWeight As Worksheet
Dim WshtSummary As Worksheet
' Updating the screen for each change can be very time consuming.
Application.ScreenUpdating = False
' * It takes the interpreter a noticable fraction of a second to process
' Worksheets("Xxxxx") because it has to look "Xxxxx" up in its collection
' of worksheet names. These cause these look ups to be performed once and
' the result stored. With all the switching between worksheets this can
' reduce duration noticably.
' * If the names of the worksheets change, only these statements will need
' amendment to fully update the macro.
' * These are not your names. If you do not accept my advice, change to
' your worksheet names
Set WshtPrice = Worksheets("Price")
Set WshtWeight = Worksheets("Weight")
Set WshtSummary = Worksheets("Summary")
' For price worksheet, find last row with a period and last column with a fruit
With WshtPrice
ColPriceLast = .Cells(1, Columns.Count).End(xlToLeft).Column
RowPriceLast = .Cells(Rows.Count, ColPWPeriod).End(xlUp).Row
End With
' For weight worksheet, find last row with a period and last column with a fruit
With WshtWeight
ColWeightLast = .Cells(1, Columns.Count).End(xlToLeft).Column
RowWeightLast = .Cells(Rows.Count, ColPWPeriod).End(xlUp).Row
End With
' Check worksheets match.
' Check same number of fruits
If ColPriceLast <> ColWeightLast Then
Call MsgBox("Worksheet " & WshtPrice.Name & " has " & _
ColPriceLast - ColPWDataFirst + 1 & _
" fruit while worksheet " & WshtWeight.Name & " has " & _
ColWeightLast - ColPWDataFirst + 1 & _
". Sorry I cannot handle this situation", _
vbOKOnly, "Combine Price and Weight worksheets")
Exit Sub
End If
' Check same number of periods
If RowPriceLast <> RowWeightLast Then
Call MsgBox("Worksheet " & WshtPrice.Name & " has " & _
RowPriceLast - RowPWDataFirst + 1 & _
" periods while worksheet " & WshtWeight.Name & " has " & _
RowWeightLast - RowPWDataFirst + 1 & _
". Sorry I cannot handle this situation", vbOKOnly, _
"Combine Price and Weight worksheets")
Exit Sub
End If
' Check same fruits in same sequence.
' Note: have already checked ColPriceLast = ColWeightLast
For ColPWCrnt = ColPWDataFirst To ColPriceLast
If WshtPrice.Cells(RowPWFruit, ColPWCrnt).Value <> _
WshtWeight.Cells(RowPWFruit, ColPWCrnt).Value Then
Call MsgBox("Cell " & ColNumToCode(ColPWCrnt) & RowPWFruit & _
" of worksheet " & WshtPrice.Name & " = """ & _
WshtPrice.Cells(RowPWFruit, ColPWCrnt).Value & _
""" while the same cell in worksheet " & _
WshtWeight.Name & " = """ & _
WshtWeight.Cells(RowPWFruit, ColPWCrnt).Value & _
""". Sorry I cannot handle this situation", vbOKOnly, _
"Combine Price and Weight worksheets")
Exit Sub
End If
Next
' Check same periods in same sequence.
' Note: have already checked RowPriceLast = RowWeightLast
For RowPWCrnt = RowPWDataFirst To RowPriceLast
If WshtPrice.Cells(RowPWCrnt, ColPWPeriod).Value <> _
WshtWeight.Cells(RowPWCrnt, ColPWPeriod).Value Then
Call MsgBox("Cell " & ColNumToCode(ColPWPeriod) & RowPWCrnt & _
" of worksheet " & WshtPrice.Name & " = """ & _
WshtPrice.Cells(RowPWCrnt, ColPWPeriod).Value & _
""" while the same cell in worksheet " & _
WshtWeight.Name & " = """ & _
WshtWeight.Cells(RowPWCrnt, ColPWPeriod).Value & _
""". Sorry I cannot handle this situation", vbOKOnly, _
"Combine Price and Weight worksheets")
Exit Sub
End If
Next
' Formats of two worksheets match
' For summary worksheet, clear existing contents, create header row
' and initialise row counter
With WshtSummary
.Cells.EntireRow.Delete ' Clear any existing contents
.Cells(1, ColSummaryFruit).Value = "Fruit"
.Cells(1, ColSummaryPeriod).Value = "Period"
.Cells(1, ColSummaryPrice).Value = "Price"
.Cells(1, ColSummaryWeight).Value = "Weight"
.Range(.Cells(1, 1), .Cells(1, ColSummaryLast)).Font.Bold = True
RowSummaryCrnt = 2
End With
For ColPWCrnt = ColPWDataFirst To ColPriceLast
' Can copy across fruit from either worksheet since checked to match
WshtSummary.Cells(RowSummaryCrnt, ColSummaryFruit).Value = _
WshtPrice.Cells(RowPWFruit, ColPWCrnt).Value
For RowPWCrnt = RowPWDataFirst To RowPriceLast
If WshtPrice.Cells(RowPWCrnt, ColPWCrnt).Value <> "" Or _
WshtWeight.Cells(RowPWCrnt, ColPWCrnt).Value <> "" Then
' There is either a price or a weight or both for this period and fruit
' Can copy across period from either worksheet since checked to match
WshtSummary.Cells(RowSummaryCrnt, ColSummaryPeriod).Value = _
WshtPrice.Cells(RowPWCrnt, ColPWPeriod).Value
' Copy across price and weight
WshtSummary.Cells(RowSummaryCrnt, ColSummaryPrice).Value = _
WshtPrice.Cells(RowPWCrnt, ColPWCrnt).Value
WshtSummary.Cells(RowSummaryCrnt, ColSummaryWeight).Value = _
WshtWeight.Cells(RowPWCrnt, ColPWCrnt).Value
' Step summart row ready fro next period or fruit
RowSummaryCrnt = RowSummaryCrnt + 1
End If
Next RowPWCrnt
Next ColPWCrnt
End Sub
Function ColNumToCode(ByVal ColNum As Long) As String
Dim Code As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
Code = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
Code = Chr(65 + PartNum) & Code
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
ColNumToCode = Code
End Function