Sub tArray_03()
'
'測試數組在同一分頁的應用
'將Range("E1:h20")內容存至數組 myRangeData_1
'再連續 copy 至 K:N 欄
'重點是 copy 時不留空格
'
'清空要 paste 的欄位資料
[j:P] = ""
'將Range("E1:h20")內容存至數組 myRangeData_1
'用.CurrentRegion 好處是不需檢測實際範圍
myRangeData_1 = Range("E1").CurrentRegion
'myRangeData_1 是兩維數組
'讀取第 1 維的下標,即組中的 行數。這裡是 20 。
LastRow = UBound(myRangeData_1, 1)
'讀取第 2 維的下標,即組中的 欄數。這裡是 4 。
LastCol = UBound(myRangeData_1, 2)
'做迴圈,連續抄寫至 K:N 欄
For i = 1 To 2000 Step 1
'先檢測 k 欄是否已存有數據,如標題列等,
'防止覆蓋之前的資料。
newLastRow = [K65536].End(xlUp).Row
'要由 k 欄開始 paste,故定義 J 欄,即 10 。
C1 = 10
'為 paste 的範圍做簡單分類設定,
'如無任何欄位,則......
If newLastRow = 1 Then
'最大預設行數定為 0
R2 = 0
'最小預設行數定為 newLastRow
R1 = newLastRow
Else
'最大預設行數定為 newLastRow
R2 = newLastRow
'最小預設行數定為 newLastRow + 1
R1 = newLastRow + 1
End If
'將數組 myRangeData_1 抄入以下範圍
'設定 copy 範圍 開始位置 Cells(R1, C1 + 1)
'設定 copy 範圍 結束位置 Cells(R2 + LastRow, C1 + LastCol)
Range(Cells(R1, C1 + 1), Cells(R2 + LastRow, C1 + LastCol)).Value = myRangeData_1
Next i
MsgBox "已完成!"
End Sub
沒有留言:
張貼留言