首先讓我們看看您現有的代碼。
For Each Name In Range("B1:D1")
這假定3種果樹。當你添加第四個時，你將不得不更新這個代碼，並且當你添加第五個時再次更新這個代碼。決定哪些水果感興趣，維持宏觀的人是否？如果沒有，每次添加水果時，他們都必須要求更新宏。
決定什麼樣的未來可能發生的變化，允許一個平衡：
- 這幾乎是沒有力氣允許額外的水果或額外的時間，並且在大多數情況下，這是一個非常可能的變化，所以我通常允許它。
- 目前你有價格和重量作爲有趣的屬性。允許新房產可能會非常棘手;我通常不會打擾。
- 水果是否在同一個序列？這些時期是否以相同的順序？考慮到這些變化比允許額外的水果或時期更麻煩，所以我應該允許這些變化嗎？在以前的生活中，我負責許多類似的任務。工作表格的格式經常被我無法理解的原因所改變。如果我簡單地認爲工作表是我期望的格式，我可以創建現實但錯誤的摘要，並且錯誤可能在一段時間內不會被識別。至少，我總是按照我預期的格式對工作表進行檢查。
我不是要你同意我對準備什麼變化的評估，因爲我對你的申請一無所知。我要求你考慮這個問題。您未檢查的更改可能會導致損壞的摘要或崩潰的宏。這有多重要？你已經檢查過但沒有處理的更改意味着只有更新它才能運行宏。這有多重要？
Worksheets("summary").Range("a65536").End(xlUP).Offset(2,1)
到Excel 2007年之前，工作表有65536行，以便細胞A65536是自2007年以來已誰編碼列A.任何的底部會建議Cells(Rows.Count, 1)，而不是Range("a65536")因爲它指定底部列的A爲當前版本的Excel，無論它是什麼。
我不喜歡Offset，因爲您必須執行心算以確定哪個單元格正在尋址。如果週期數不總是正好三個，則必須在偏移行上執行算術運算。那就是：Offset(2, 1)將不得不被Offset(2+Period-1, 1)之類的東西取代。另外，您已經開始在列A的底部，在執行偏移量之前將其移動到列中的第一個單元格。
如果您的代碼每天要執行數百萬次，那麼將運行時間減少一毫秒可能是合適的，但在這裏適合嗎？您需要花多長時間編寫這些代碼（反正無法使用），以及您的代碼的未來維護人員需要多長時間才能瞭解您正在執行的操作？我的建議是使代碼簡單易寫，除非有一些壓倒性的原因使其複雜且難以編寫。
我的代碼包含了一些節省時間的小技巧。這些都很容易實現，可以自動化。如果您需要10秒或20秒才能輸入一條能夠爲用戶節省大量時間的聲明，那麼公司可以在幾個月內獲得投資回報（您的編碼時間爲<用戶的等待時間）。此外，這些技巧中的一些使未來的維護更容易。對於需要在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
偏移量是在一系列的方法，你想@chrisneilsen我編輯的代碼，並嘗試過，但它仍然無法正常工作，使用它在工作表 – 2015-03-30 23:31:03
。感謝您指出編輯。 – Jain 2015-03-30 23:53:06