返回列表 上一主題 發帖

[發問] 請問是否有辦法按照當滑鼠點到的順序去排序?(已完成，謝Hsieh大大)

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
1# 跳轉到 »
發表於 2012-2-15 17:14 | 顯示全部帖子
本帖最後由 register313 於 2012-2-15 17:24 編輯

B1.rar (8.3 KB) 回復 7# av8d

修改Hsieh超版之程式
2倍的程式碼,參考

工作表模組
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2. Application.EnableEvents = False
  3. If Target.Count = 1 Then
  4. If Target.Column = 1 Then
  5.     ReDim Preserve Ar(s)
  6.     Ar(s) = Target.Value
  7.     s = s + 1
  8.     [B65536].End(xlUp).Offset(1) = Target
  9.     Target.Delete xlShiftUp
  10. ElseIf Target.Column = 3 Then
  11.     ReDim Preserve Ar1(t)
  12.     Ar1(t) = Target.Value
  13.     t = t + 1
  14.     [D65536].End(xlUp).Offset(1) = Target
  15.     Target.Delete xlShiftUp
  16. End If
  17. End If
  18. Application.EnableEvents = True
  19. End Sub
複製代碼
一般模組
  1. Public Ar(), Ar1(), s&, t&
  2. Sub 按鈕1_Click()
  3. Application.EnableEvents = False
  4. If (s <> 0) Then
  5. [A1].Resize(s, 1).Insert xlShiftDown
  6. [A1].Resize(s, 1).Value = Application.Transpose(Ar)
  7. Range([B2], [B2].End(xlDown)).ClearContents
  8. s = 0: Erase Ar: Set Rng = Nothing
  9. End If
  10. If (t <> 0) Then
  11. [C1].Resize(t, 1).Insert xlShiftDown
  12. [C1].Resize(t, 1).Value = Application.Transpose(Ar1)
  13. Range([D2], [D2].End(xlDown)).ClearContents
  14. t = 0: Erase Ar1: Set Rng = Nothing
  15. End If
  16. Application.EnableEvents = True
  17. End Sub
複製代碼

TOP

        靜思自在 : 真正的愛心，是照顧好自己的這顆心。
返回列表 上一主題