- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
6#
發表於 2012-1-18 10:46
| 只看該作者
回復 5# h60327 - Option Explicit
- Sub Ex()
- Dim Ar(), xi As Integer, xB As Integer, Rng As Range, xSh As Variant
- xB = 0 '動態陣列: 最後一維元素的數量(xB)
- For Each xSh In Array("一組", "二組", "三組") '陣列: 須處裡的工作表名稱
- With Sheets(xSh) '代入陣列元素
- xi = 4 '設定工作表開始的儲存格的列數
- Do While .Cells(xi, "B") <> "" '執行迴圈Do Loop的條件: B欄的儲存格 <> ""
- If .Cells(xi, "Q") >= 6 Then 'Q欄的儲存格>=6
- ReDim Preserve Ar(1 To 6, xB) '動態陣列: ReDim(調整) 最後一維元素的數量(xB)
- 'Preserve 選擇性引數。當改變原有陣列最後一維的大小時，仍然保有原來的資料的關鍵字。
- Set Rng = Sheets("人資").Cells.Find(.Cells(xi, "B")) 'Sheets("人資")中尋找 .Cells(xi, "B") :
- Ar(1, xB) = Rng.Cells(1, 2) '寫入:姓名欄往右2欄
- Ar(2, xB) = Rng.Cells(1, 3)
- Ar(3, xB) = Rng '寫入:姓名欄
- Ar(4, xB) = Rng.Cells(1, 4)
- Ar(5, xB) = "100下半年優點達" & IIf(.Cells(xi, "Q") >= 12, "12", "6") & "次，辛勞得力"
- Ar(6, xB) = "嘉獎" & IIf(.Cells(xi, "Q") >= 12, "貳次（4002）", "壹次（4001）")
- xB = xB + 1 '最後一維元素的數量(xB)
- End If
- xi = xi + 1 '使B欄的儲存格往下一列移動
- Loop
- End With
- Next
- If xB <> 0 Then '動態陣列有元素存在
- With Sheets("本案獎懲建議名冊")
- .Range(.[a3], .[a3].End(xlDown)).Resize(, 6) = "" '清除原有內容
- .[a3].Resize(xB, 6) = Application.Transpose(Ar) ' Transpose : 轉置(工作表函數)
- End With
- MsgBox "符合的資料 共 " & xB & "筆"
- Else
- MsgBox "查無 符合的資料"
- End If
- End Sub
|
|
發表於 2012-1-17 14:28
| 
