2010年11月10日 星期三

VBA 測試數組在同一分頁的應用

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

沒有留言: