最近兩天我一直在嘗試讓調整大小的 vba 作業。我需要在第 19 列之后復制和粘貼 3 列（Q、R、S）。這必須發生，直到 3 列集（i，Q:S 的副本）的數量等于單元格中的值（“C18 ")，同樣，如果 QRS 的重復次數大于 C18 中的值，則應洗掉不必要的副本。當它只是一個列時，調整大小作業正常，但現在我嘗試添加或洗掉一組 3 個，它出錯了。副本數不等于（“C18”）中的值和副本數當我重新運行子程式時，制作或洗掉不是恒定的。
有沒有人有辦法解決嗎？
Sub resize()
Dim SLastCol As Long
Dim i As Long
i = Range("C18").Value * 3
SLastCol = Cells(1, Columns.Count).End(xlToLeft).Column - 19
If SLastCol < i Then
Columns("Q:S").EntireColumn.copy
Columns("T").EntireColumn.Resize(, Abs(SLastCol - i)).Insert shift:=xlToRight
ElseIf SLastCol > i Then
Columns("T:W").EntireColumn.Resize(, Abs(SLastCol - i)).Delete shift:=xlToLeft
End If
Application.CutCopyMode = False
End Sub
uj5u.com熱心網友回復：
請測驗下一個代碼。它將復制range 中的所有列colsRng，次數與“C8”中所寫的一樣多：
Sub resizeColumnsCopy()
Dim i As Long, colsRng As Range, lastCol As Long, rngDel As Range, arrCols, arrPrevCols
'identify the previous processed columns and delete them, if any
lastCol = cells(1, Columns.count).End(xlToLeft).Column
arrPrevCols = Range(cells(1, 20), cells(1, lastCol)).Value 'place the headers after column 20 in an array
arrCols = Range("Q1:S1").Value 'do the same with the copied columns headers
For i = 1 To UBound(arrPrevCols, 2) Step 3 'iterate in the larger array, from three to three columns
If arrPrevCols(1, i) = arrCols(1, 1) Then 'finding the first column header
If rngDel Is Nothing Then
Set rngDel = Range(cells(1, 19 i), cells(1, 19 i 2)) 'create a range of the three involved columns
Else
Set rngDel = Union(rngDel, Range(cells(1, 19 i), cells(1, 19 i 2))) 'careate a Union between the previous range and the next three
End If
End If
Next i
If Not rngDel Is Nothing Then rngDel.EntireColumn.Delete 'if cases of processed columns found, then delete the columns
i = Range("C18").Value
Set colsRng = Columns("Q:S")
colsRng.Copy
cells(1, colsRng.Column colsRng.Columns.count).EntireColumn.resize(, i * colsRng.Columns.count).Insert Shift:=xlToRight
Application.CutCopyMode = False
End Sub
但是，請編輯您的問題并解釋先前處理的列洗掉的必要性。否則，查看我的代碼的其他人會認為我最近撞到了頭......
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/417868.html
標籤：