- 帖子
- 552
- 主題
- 3
- 精華
- 0
- 積分
- 578
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2015-2-8
- 最後登錄
- 2024-2-26
  
|
14#
發表於 2016-8-24 19:43
| 只看該作者
本帖最後由 lpk187 於 2016-8-24 19:52 編輯
回復 13# Michelle-W
你原本是可以利用"統計"的代碼去實現你的問題的，我只多了幾列代碼而已
參考下面代碼：- Sub 統計()
- co = Sheets("統計").Rows(1).SpecialCells(xlCellTypeConstants)
- With Sheets("統計")
- For Each Rng In .Rows(1).SpecialCells(xlCellTypeConstants)
- ro = .Cells(.Rows.Count, Rng.Column).End(xlUp).Row
- If ro > 2 Then .Range(.Cells(3, Rng.Column), .Cells(ro, Rng.Offset(, 2).Column)).Clear
- ro = 0
- Next
- End With
- co = Cells(1, Columns.Count).End(xlToLeft).Column
- ro = Cells(Rows.Count, 1).End(xlUp).Row
- For Each Rng In Range("C2", Cells(ro, co))
- If Rng.Value Like "●" Then
- With Sheets("統計")
- Set c = .Rows(1).Find(Cells(1, Rng.Column))
- If Not c Is Nothing Then
- ro = .Cells(Rows.Count, c.Column).End(xlUp).Row + 1
- .Cells(ro, c.Column) = Cells(Rng.Row, 1)
- .Cells(ro, c.Offset(, 1).Column) = Cells(Rng.Row, 2)
- '''.擷取人名
- T = Split(Cells(Rng.Row, 1) & "//", "//")(1)
- T = Split(T & "/", "/")(0)
- If T <> "" Then .Cells(ro, c.Offset(, 2).Column) = T
- ''''寫入新增
- Set cr = Sheets("新增").Columns(1).Find(Cells(Rng.Row, 1)) '查詢在哪一列
- If Not cr Is Nothing Then
- Set cc = Sheets("新增").Rows(1).Find(c.Value) '查詢在哪一欄
- If Not cc Is Nothing Then
- Sheets("新增").Cells(cr.Row, cc.Column) = Rng.Value '然後放入"●"
- End If
- End If
- End If
- Set c = Nothing
- Set sr = Nothing
- Set cc = Nothing
- End With
- End If
- Next
- 'Module1.擷取人名<<<這裡可以不用啦！
- End Sub
|
|
發表於 2016-8-24 21:18
| 
發表於 2016-8-25 11:09
| 
