iT邦幫忙

0

巨集排序資料

匿名 3 年前4013 瀏覽

請問各位先進,關於EXCEL巨集的問題
取得外部資料匯入資料後
希望資料由上至下.由左至右排序
A1~A10 完接著 B1~B10 然後在 C1~C10 換 A11~A20 接 B11~B20 .....

如上的方式排序,該如何下手?
如果要加入一些像是固定欄位的寬度.行列的高度.字型大小自動縮排?
以上問題,謝謝您耐心看完

1 個回答

4
scorpion
iT邦新手 4 級 ‧ 3 年前
最佳解答

程式碼供您參考,歡迎指正。可以嘗試錄製後再修改成自己要的比較方便(因為小弟也不熟)。基本上依您所需,但無法得知您有多少區塊(例:A1~A10,A11~A20),所以需要重複操作到您的區塊結束。
提醒:
1.程式碼貼上即可使用,執行時套用到當前工作的工作表。
2.巨集執行完後無法回復上一步驟,請特別注意。建議先存檔再執行相關巨集。

<pre class="c" name="code">
Option Explicit
Option Base 1

Sub Macro_test()
On Error Resume Next
Dim i, column_num, row_range_start, row_range_end, sort_type_input_num As Integer

column_num = CInt(InputBox("請輸入欄總數(即A到D欄共4欄,輸入4)", , 4))
row_range_start = CInt(InputBox("請輸入列起始值(預設A1即輸入1)" & vbCrLf & vbCrLf & "(即A1或A11或B1...等)", , 1))
row_range_end = CInt(InputBox("請輸入列終止值(預設A10即輸入10)" & vbCrLf & vbCrLf & "(即A10或A20或B10...等)", , 10))
sort_type_input_num = CInt(InputBox("請輸排序方式(預設遞增)" & vbCrLf & vbCrLf & "(1:遞增 , 2:遞減)", , 1))   '1:xlAscending, 2:xlDescending


    Cells.Select                   '整個工作表選取
    Selection.ColumnWidth = 10     '固定欄位寬度
    Selection.RowHeight = 15      '固定行列高度
    With Selection
        .ShrinkToFit = True        '字型大小自動縮排(儲存格→對齊方式→縮小字型適合欄寬,請確認是否為妳要的功能)
    End With
    

    Select Case sort_type_input_num
    Case 1  '遞增
        For i = 1 To column_num
            ActiveSheet.Sort.SortFields.Clear
            ActiveSheet.Sort.SortFields.Add _
                Key:=Range(Cells(row_range_start, i), Cells(row_range_end, i)) _
                , SortOn:=xlSortOnValues _
                , Order:=xlAscending _
                , DataOption:=xlSortNormal
            
            With ActiveSheet.Sort
                .SetRange Range(Cells(row_range_start, i), Cells(row_range_end, i))
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        Next
        
    Case 2  '遞減
        For i = 1 To column_num
            ActiveSheet.Sort.SortFields.Clear
            ActiveSheet.Sort.SortFields.Add _
                Key:=Range(Cells(row_range_start, i), Cells(row_range_end, i)) _
                , SortOn:=xlSortOnValues _
                , Order:=xlDescending _
                , DataOption:=xlSortNormal
            
            With ActiveSheet.Sort
                .SetRange Range(Cells(row_range_start, i), Cells(row_range_end, i))
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        Next
    End Select
   
Error:
MsgBox "輸入值錯誤或程式有問題,請自行修改"

End Sub
匿名 檢舉

http://ithelp.ithome.com.tw/upload/images/20140305/2014030510335353168d11bfa7a\_thumb.PNG
http://ithelp.ithome.com.tw/upload/images/20140305/2014030510341253168d245f1d9\_thumb.PNG
不好意思,可能我上面講不太清楚,如圖示
名單資料(圖A)有上千筆,希望按照筆劃或者英文由小至大排序
排序規則(圖B),筆劃最少開始至A1開始往下到A10排序換欄至B1往下到B10再到C1~C10接著至A11~A20 B11~B20 C11~C20 A21~A30...以此方式往下排序
謝謝您的回答^^

scorpion iT邦新手 4 級 ‧ 3 年前 檢舉

雖然你的圖極度馬賽克,部過大概了解您的資料結構。
以下小弟的建議,也請指導並嘗試修改看看。
0.『按照筆劃』排序這是一個好問題,因為我不確定字元的code是否真的照『筆劃』建制。英文則是先大寫後小寫吧!(參考ASCII wiki)
1.因為不確定資料是否只有3欄,所以作互動式的。若資料格式固定,則程式可寫死此變數。
2.因為列數範圍不確定,所以作互動式的。當然也可以程式自動決定最後範圍,然後再依照規則10列一組去計算再排序(多一層for迴圈)。但小弟的經驗中(錯誤還請指導我),空白的儲存格可能會導致誤判範圍甚而影響排序。

匿名 檢舉

Sorry,上傳圖片不是很會用,傷眼了
如果『按照筆劃』排序這部分省略
資料名冊為一欄上千筆名單,轉成三欄我要的排序方式?

很感謝您耐心地指導並回覆我的問題
我大概只聽得懂for迴圈,慚愧
程式部分我可能還是不太行......

我要發表回答

立即登入回答