返回列表 上一主題 發帖

[發問] 選項按鈕

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
1# 跳轉到 »
發表於 2016-8-22 19:29 | 顯示全部帖子
回復 1# Michelle-W

請試看看，是不是你要的，也不知道對不對！
    選項按鈕.rar (92.86 KB)

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
2#
發表於 2016-8-22 19:53 | 顯示全部帖子
回復 1# Michelle-W


    我多寫了一列代碼，可能不是你需要的，可以把它刪除
.Cells(ro, c.Offset(, 2).Column) = 1

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
3#
發表於 2016-8-23 13:59 | 顯示全部帖子
本帖最後由 lpk187 於 2016-8-23 14:05 編輯

回復 5# Michelle-W

物件太多，佔的記憶體也相對多，會影響到整體的執行，所以會產生錯誤
建議你可以用其他方法來處理同樣問題，而少用OptionButton
例如：使用工作表事件Worksheet_SelectionChange來取代物件OptionButton的使用
也會得到相同的效果

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
4#
發表於 2016-8-23 15:38 | 顯示全部帖子
回復 7# Michelle-W

試試看

不只只選取一個儲存格，也可以一次選取一個欄位，但2個欄位以上就不行了

選項按鈕(非選擇按鈕).rar (54.71 KB)

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
5#
發表於 2016-8-23 15:48 | 顯示全部帖子
回復 7# Michelle-W


    依據准大說的SelectionChange 容易發生誤觸

所以也可以改用下列代碼，在該儲存格中點2下
  1. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  2.     co = Cells(1, Columns.Count).End(xlToLeft).Column
  3.         If Target.Column > 2 And Target.Column < 9 And Target.Row > 1 And Cells(Target.Row, 1) <> "" And Cells(1, Target.Column) <> "" Then
  4.             Range(Cells(Target.Row, "C"), Cells(Target.Row, co)) = "" '先清空原來的"●"
  5.             Target.Value = "●"
  6.         End If
  7. End Sub
複製代碼

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
6#
發表於 2016-8-24 19:43 | 顯示全部帖子
本帖最後由 lpk187 於 2016-8-24 19:52 編輯

回復 13# Michelle-W

你原本是可以利用"統計"的代碼去實現你的問題的，我只多了幾列代碼而已
參考下面代碼：
  1. Sub 統計()
  2.     co = Sheets("統計").Rows(1).SpecialCells(xlCellTypeConstants)
  3.     With Sheets("統計")
  4.         For Each Rng In .Rows(1).SpecialCells(xlCellTypeConstants)
  5.             ro = .Cells(.Rows.Count, Rng.Column).End(xlUp).Row
  6.             If ro > 2 Then .Range(.Cells(3, Rng.Column), .Cells(ro, Rng.Offset(, 2).Column)).Clear
  7.             ro = 0
  8.         Next
  9.     End With
  10.     co = Cells(1, Columns.Count).End(xlToLeft).Column
  11.     ro = Cells(Rows.Count, 1).End(xlUp).Row
  12.     For Each Rng In Range("C2", Cells(ro, co))
  13.         If Rng.Value Like "●" Then
  14.             With Sheets("統計")
  15.                 Set c = .Rows(1).Find(Cells(1, Rng.Column))
  16.                  If Not c Is Nothing Then
  17.                     ro = .Cells(Rows.Count, c.Column).End(xlUp).Row + 1
  18.                     .Cells(ro, c.Column) = Cells(Rng.Row, 1)
  19.                     .Cells(ro, c.Offset(, 1).Column) = Cells(Rng.Row, 2)
  20.                     '''.擷取人名
  21.                     T = Split(Cells(Rng.Row, 1) & "//", "//")(1)
  22.                     T = Split(T & "/", "/")(0)
  23.                     If T <> "" Then .Cells(ro, c.Offset(, 2).Column) = T
  24.                     ''''寫入新增
  25.                     Set cr = Sheets("新增").Columns(1).Find(Cells(Rng.Row, 1)) '查詢在哪一列
  26.                     If Not cr Is Nothing Then
  27.                         Set cc = Sheets("新增").Rows(1).Find(c.Value) '查詢在哪一欄
  28.                         If Not cc Is Nothing Then
  29.                             Sheets("新增").Cells(cr.Row, cc.Column) = Rng.Value '然後放入"●"
  30.                         End If
  31.                     End If
  32.                 End If
  33.                 Set c = Nothing
  34.                 Set sr = Nothing
  35.                 Set cc = Nothing
  36.             End With
  37.         End If
  38.     Next
  39. 'Module1.擷取人名<<<這裡可以不用啦！
  40. End Sub
複製代碼

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
7#
發表於 2016-8-24 20:09 | 顯示全部帖子
回復 13# Michelle-W

另外，如果我把For Each Rng In Range("C2", Cells(ro, co))這列代碼又修改成
   For Each Rng In Range("C2", Cells(ro, co)).SpecialCells(xlCellTypeConstants)
是不是又會更快了一些！

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
8#
發表於 2016-8-24 23:08 | 顯示全部帖子
本帖最後由 lpk187 於 2016-8-24 23:13 編輯

回復 17# Michelle-W

我的建議：
1。你目前應該先瞭解"統計"這個程序中的代碼，以及其意義。
      寫下選擇工作表中的"統計"程序並不一定只能在選擇工作表中執行！
      當然我寫的代碼只能在其工作表中執行，但也只須修改幾個語法就能夠在其他的工作表中執行！
      其中的Cells()、Range()，這些都必須要正確的地址給它，然後就當然可以在其他的工作表中實現
2。有辦法可以由第一項開始依序排列順序嗎~?
      可以解釋"依序排列順序"嗎？
      從哪依序？人員？編號？還是依據目前的新增工作表之排序？
其實你本身代碼理解還蠻不錯的，再想一下，你一定可以的！

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
9#
發表於 2016-8-25 14:10 | 顯示全部帖子
回復 19# Michelle-W


    我的理解是最後做排序的動作，是這樣嗎？還是要再做另一個程序？
  1. Sub 統計()
  2.     co = Sheets("統計").Rows(1).SpecialCells(xlCellTypeConstants)
  3.     With Sheets("統計")
  4.         For Each Rng In .Rows(1).SpecialCells(xlCellTypeConstants)
  5.             ro = .Cells(.Rows.Count, Rng.Column).End(xlUp).Row
  6.             If ro > 2 Then .Range(.Cells(3, Rng.Column), .Cells(ro, Rng.Offset(, 2).Column)).Clear
  7.             ro = 0
  8.         Next
  9.     End With
  10.     co = Cells(1, Columns.Count).End(xlToLeft).Column
  11.     ro = Cells(Rows.Count, 1).End(xlUp).Row
  12.     For Each Rng In Range("C2", Cells(ro, co)).SpecialCells(xlCellTypeConstants)
  13.         If Rng.Value Like "●" Then
  14.             With Sheets("統計")
  15.                 Set c = .Rows(1).Find(Cells(1, Rng.Column))
  16.                  If Not c Is Nothing Then
  17.                     ro = .Cells(Rows.Count, c.Column).End(xlUp).Row + 1
  18.                     .Cells(ro, c.Column) = Cells(Rng.Row, 1)
  19.                     .Cells(ro, c.Offset(, 1).Column) = Cells(Rng.Row, 2)
  20.                     '''.擷取人名
  21.                     T = Split(Cells(Rng.Row, 1) & "//", "//")(1)
  22.                     T = Split(T & "/", "/")(0)
  23.                     If T <> "" Then .Cells(ro, c.Offset(, 2).Column) = T
  24.                     ''''寫入新增
  25.                     Set cr = Sheets("新增").Columns(1).Find(Cells(Rng.Row, 1)) '查詢在哪一列
  26.                     If Not cr Is Nothing Then
  27.                         Set cc = Sheets("新增").Rows(1).Find(c.Value) '查詢在哪一欄
  28.                         If Not cc Is Nothing Then
  29.                             Sheets("新增").Cells(cr.Row, cc.Column) = Rng.Value '然後放入"●"
  30.                         End If
  31.                     End If
  32.                 End If
  33.                 Set c = Nothing
  34.                 Set sr = Nothing
  35.                 Set cc = Nothing
  36.             End With
  37.         End If
  38.     Next
  39.     ''''排序
  40.     Set Rng = Sheets("新增").Range("a1").CurrentRegion
  41.     For i = Rng.Columns.Count To 3 Step -1
  42.          Rng.Sort Key1:=Rng(1, i), Order1:=xlAscending, Header:=xlYes
  43.     Next

  45. 'Module1.擷取人名<<<這裡可以不用啦！
  46. End Sub
複製代碼

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-2-26 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
10#
發表於 2016-8-25 22:30 | 顯示全部帖子
回復 23# Michelle-W


    Qestion(內含解釋).rar (29.85 KB)

TOP

        靜思自在 : 能幹不幹，不如苦幹實幹。
返回列表 上一主題