我正在嘗試編輯我的代碼，因為盡管它可以根據需要運行，但我知道它效率不高。我一次復制 5 個合并的單元格，并將復制的資料粘貼到左側列中，然后再清除復制的范圍。
跳過每第 6 個單元格，因為它不適用于需要移動的內容。下面是一個片段，我知道有一種更有效的方法來做我在這里做的事情，但我是全新的，基本上沒有宣告變數或利用回圈、函式等的經驗。
提前致謝！
Option Explicit
Sub ShiftWeeks()
Dim answer As VbMsgBoxResult
answer = MsgBox("Are you sure you want to copy/paste this weeks data?", vbYesNo, "Press Button for Macro")
If answer = vbYes Then
Range("c3:c8").Copy
Range("b3:b8").PasteSpecial xlPasteValues
Range("c3:c8").ClearContents
Range("c10:c15").Copy
Range("b10:b15").PasteSpecial xlPasteValues
Range("c10:c15").ClearContents
Range("c17:c22").Copy
Range("b17:b22").PasteSpecial xlPasteValues
Range("c17:c22").ClearContents
Range("c24:c29").Copy
Range("b24:b29").PasteSpecial xlPasteValues
Range("c24:c29").ClearContents
End If
End Sub
我已經多次復制相同的 3 個代碼塊，并且剛剛更改了范圍。我制作的按鈕有效，但我知道代碼是垃圾代碼，這并不難，但我不知道如何清理它。
uj5u.com熱心網友回復：
不要吹毛求疵，但看起來你實際上是一次復制 6 行，而不是 5 行（例如 C3:C8 是六行）。按照與上面相同的模式，您可以使用For x = y to z step a-style 回圈，如下所示。如果最后一行始終相同，您可以使用lastRow = y陳述句定義它，否則您可以使用類似lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row.
For x = 3 To lastRow Step 7
' exit loop if you got past the last row somehow
If x > lastRow Then GoTo exitfor
ws.Range(ws.Cells(x, 3), ws.Cells(x 5, 3)).Copy
ws.Range(ws.Cells(x, 2), ws.Cells(x 5, 2)).PasteSpecial xlPasteValues
ws.Range(ws.Cells(x, 3), ws.Cells(x 5, 3)).ClearContents
Next x
exitfor:
uj5u.com熱心網友回復：
回圈播放
如果您需要添加十幾個范圍，則必須在每個范圍重復代碼行是乏味的，并且很快就會變得難以管理。為避免此問題，您可以將代碼更改為回圈。
有兩種方法可以創建回圈。
按塊：
Sub Example()
For r = 3 To 24 Step 7
With Cells(r, 3).Resize(6)
.Offset(0, -1).Value = .Value
.ClearContents
End With
Next
End Sub
并按細胞：
Sub Example()
Dim Cell As Range
For Each Cell In Range("c3:c8,c10:c15,c17:c22,c24:c29")
With Cell
.Offset(0, -1).Value = .Value
.ClearContents
End With
Next
End Sub
在塊回圈中，我們定義了起始位置（r=3和Cells ColumnIndex:=3），然后是塊大小（Step 7和Resize(6)）。在 Cells 回圈中，我們只需定義要在其中操作的范圍，并在該范圍內的每個單元格上執行所需的操作。
在這兩種方法中，向宏添加新位置就像更改For回圈陳述句行一樣簡單。通過從 24 增加結束編號或向Range.
剪貼板復制
剪貼板不是 Excel 的本機功能，實際上是 Windows 的一部分。這意味著當您在單獨的行中使用.Copy和.PasteSpecial時，Excel 必須與視窗通信并共享資料。這比將資料保留在 Excel 中要慢得多。通過在Range2.Value = Range1.Value不使用剪貼板的情況下直接分配資料來避免此問題。您也可以這樣做，Range1.Copy Destination:=Range2但這會復制格式和值。
其他改進
如果您測驗單元格回圈，您會注意到應用程式卡頓并且可能非常慢。為避免這種情況，您需要暫時禁用應用程式的自動操作，以便它不會在每個回圈期間暫停。應用程式希望在每次更改后重新計算作業表并重繪 螢屏以顯示新值。這兩者都是口吃的原因，在宏期間禁用它們將顯著加快速度。
Sub Example()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
''''''''''''''''
'Code goes here'
''''''''''''''''
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
uj5u.com熱心網友回復：
復制合并范圍
Option Explicit
Sub ShiftWeeks()
Const wsName As String = "Sheet1"
Const fRow As Long = 3
Const sCol As String = "C"
Const cOffset As Long = -1
Const rOffset As Long = 7 ' needed only for the second solution
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
Dim answer As VbMsgBoxResult
answer = MsgBox("Are you sure you want to copy/paste this weeks data?", vbYesNo, "Press Button for Macro")
If answer = vbYes Then
Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
If lRow < fRow Then Exit Sub ' no data
' 1.) If the rows between the merged ranges are empty...
Dim srg As Range: Set srg = ws.Cells(fRow, sCol).Resize(lRow - fRow 1)
srg.Offset(, cOffset).Value = srg.Value
srg.Value = Empty
' 2.) ... otherwise:
' Dim sCell As Range
' Dim r As Long
'
' For r = fRow To lRow Step rOffset
' Set sCell = ws.Cells(r, sCol)
' sCell.Offset(, cOffset).Value = sCell.Value
' sCell.Value = Empty
' 'sCell.MergeArea.ClearContents
' Next r
End If
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qita/409008.html
標籤：