返回列表 上一主題 發帖

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

av8d

帖子
703 
主題
276 
精華
0 
積分
1005 
點名
1  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2011-6-30 
最後登錄
2024-5-29 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-2-13 16:56 | 只看該作者

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

本帖最後由 av8d 於 2012-2-15 15:50 編輯

我剛錄製了一個巨集
    Range("C7").Select
    Application.CutCopyMode = False
    Selection.Cut
    Range("C2").Select
    Selection.Insert Shift:=xlDown

這是把C7剪下然後貼到C2上方的巨集


是否有辦法讓記憶體堆疊資料呢?
例如:按照點到的先後順序去排序，
1.C2 → C1
2.C5 → C2
3.C3 → C3
4.C4 → C4
5.C1 → C5
按照點的順序從新排列。
收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
255  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-25 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2012-2-13 21:05 | 只看該作者
回復 1# av8d

假設資料在A欄
工作表模組
  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. End If
  11. End If
  12. Application.EnableEvents = True
  13. End Sub
複製代碼
一般模組
  1. Public Ar(), s&
  2. Sub 按鈕1_Click()
  3. If s = 0 Then Exit Sub
  4. Application.EnableEvents = False
  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. Application.EnableEvents = True
  10. End Sub
複製代碼
play.gif
學海無涯_不恥下問

TOP

av8d

帖子
703 
主題
276 
精華
0 
積分
1005 
點名
1  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2011-6-30 
最後登錄
2024-5-29 
3#
發表於 2012-2-15 11:58 | 只看該作者
回復 2# Hsieh


    板大抱歉~如果是XP版的話

該如何改寫呢?

XP版會顯示

編譯錯誤:
物件模組中的Public成員不可以是常數、固定長度的字串、陣列、使用者自訂型態或Declare陳述式

說明:
物件類別模組中的 Public 成員不可以是：常數、固定長度的字串、使用者定義型態、陣列或 Declare 陳述式
並非所有物件模組中的變數都可宣告成 Public。然而，程序在預設上是 Public，且 Property 程序在語法結構上可比照變數。這個錯誤的起因與解決方法如下所示：
您在物件模組中宣告了一個 Public 常數。
雖然您不能在物件模組中宣告 Public 常數，但您可以相同名稱建立一個Property Get 程序。若您不以相同名稱建立一個 Property Let 或 Property Set 程序，您實際上將建立一個唯讀屬性，其用法與常數相同。

您在物件模組中宣告了一個 Public 型態的固定長度字串。
您可用 Property 程序模擬固定長度字串，並截掉超出長度的字串資料，或提示使用者超出長度。

您在物件模組中宣告了一個 Public 陣列。
雖然程序不能傳回陣列，但可傳回一個包含陣列的 Variant。要再物件類別模組中模擬一個 Public 陣列，可使用一組可接受與傳回包含陣列之 Variant 的 Property 程序。

您在物件模組中放了一個 Declare 陳述式。
Declare 陳述式都是公用的，您可在 Declare 陳述式之前加上一個 Private 關鍵字。

詳細資訊，請先選取有疑問的項目，然後按下 F1 (在 Windows中) 或 HELP (在 Macintosh上)。

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
255  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-25 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2012-2-15 15:34 | 只看該作者
回復 3# av8d
沒有XP版本，2003測試可以通過
Book1.zip (8.52 KB)
學海無涯_不恥下問

TOP

av8d

帖子
703 
主題
276 
精華
0 
積分
1005 
點名
1  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2011-6-30 
最後登錄
2024-5-29 
5#
發表於 2012-2-15 15:50 | 只看該作者
本帖最後由 av8d 於 2012-2-15 16:03 編輯

回復 4# Hsieh


    2003版可用，萬分感謝。

您好~我想在詢問一下如果要調整A和B欄該如何修改呢?

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
255  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-25 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2012-2-15 16:25 | 只看該作者
本帖最後由 Hsieh 於 2012-2-15 16:27 編輯

回復 5# av8d


    設計模式下更改A欄資料
更改完成後再結束設計模式
play.gif
學海無涯_不恥下問

TOP

av8d

帖子
703 
主題
276 
精華
0 
積分
1005 
點名
1  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2011-6-30 
最後登錄
2024-5-29 
7#
發表於 2012-2-15 16:44 | 只看該作者
本帖最後由 av8d 於 2012-2-15 16:47 編輯

回復 6# Hsieh

誤會了~我的意思式A欄位改成C欄位~B欄位改成D欄位要如何修改呢?
If Target.Count = 1 Then
If Target.Column = 1 Then

是1改成3嗎?還是要重寫?

    剛好問一下~設計模式和結束設計模式~做成開關按鈕~是否有辦法?

順便問一下指令按鈕一定要寫在SHEET裡面嗎?
如果是，請問您的按鈕是哪一種按鈕呢?沒有寫在SHEET裡面是因為怕變數會衝突到嗎?還是?

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

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

2012龍年全勤獎章熱烈參與勳章
8#
發表於 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

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題