- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
2#
發表於 2014-3-17 12:54
| 只看該作者
回復 1# ClareWu
試試看:
 - Option Explicit
- '複製被勾選的 個人防護具
- Private Sub CommandButton1_Click()
- Dim Rng, rngB As Range, endRow, Row1 As Integer
-
- '從 [A65536] 由下往上找, 直到找到 非空白格 為止的 Row(列數值)
- endRow = [A65536].End(xlUp).Row
-
- '清除欄C
- [C2:C65536] = ""
-
- '設定 rngB 的範圍
- Set rngB = [B2].Resize(endRow, 1)
-
- '對於 rngB 的每一個成員 Rng 來說,
- For Each Rng In rngB
-
- '如果 Rng 的右一格是 "v"
- If Rng = "v" Then
-
- '非空白格 的 下一格 = 空白格
- Row1 = [C65536].End(xlUp).Row + 1
-
- '欄C空白格 的值 = Rng 的左一格 的值
- Cells(Row1, 3) = Rng.Offset(0, -1)
- End If
- Next
- End Sub
- '利用 欄B 勾選要複製的項目
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- Dim Rng, rngB As Range, endRow As Integer
-
- endRow = [A65536].End(xlUp).Row
- Set rngB = [B1].Resize(endRow, 1)
-
- 'Intersect(Target, rngB) 可將 SelectionChange
- '所觸動的有效範圍限制在 rngB 中,
- 'rngB Is Nothing→表示 rngB 未被觸動
- 'Not Intersect(Target, rngB) Is Nothing
- '→ 表示 rngB 被觸動了(負負得正)
- If Not Intersect(Target, rngB) Is Nothing Then
- If Target = "v" Then
- Target = ""
- Else
- Target = "v"
- End If
- End If
- End Sub
|
|
發表於 2014-3-18 09:51
| 
