tata色々な備忘録

データ解析、画像解析、化学分析などなど

VBAでソート

とりあえず書いてみた。

以下のようなデータがあるとして

pos    cur     lots        price  
Buy     USD     10,000,000   120.5  
Buy     USD     10,000,000   119.5  
Buy     EUR     1,000,000    132.5  
Buy     EUR     1,000,000    130.5  
Sell    USD     10,000,000   121.5  
Buy     USD     10,000,000   118.5  
Sell    USD     10,000,000   122.5  

posやcur、up or down指定で並べ替え後、行頭に移動

pos    cur     lots        price  
Buy     USD     10,000,000   120.5  
Buy     USD     10,000,000   119.5  
Buy     USD     10,000,000   118.5  
Sell    USD     10,000,000   121.5  
Sell    USD     10,000,000   122.5  
Buy     EUR     1,000,000    132.5  
Buy     EUR     1,000,000    130.5  

VBAのコード

Sub sort_cur_pos()
    Dim first_row As Long
    Dim last_row As Long
    Dim row_counts As Long
    Dim cur As String
    Dim pos As String
    Dim up_or_down As String
    
    'ソートする項目と方法を指定
    cur = "USD"
    pos = "Sell"
    up_or_down = "up"
    
    '全体選択
    cells(1, 1).Select
    Selection.CurrentRegion.Select
    
    '行数のカウント
    all_row_end = ActiveWindow.RangeSelection.End(xlDown).Row
    
    '全体を選択してプレソート
    cells_area = ActiveWindow.RangeSelection.Address
    Worksheets("Sheet1").Range(cells_area) _
             .Sort Key1:=cells(1, 2), order1:=xlDescending, _
             Key2:=cells(1, 1), order2:=xlAscending
    
    '指定項目の範囲を調査して格納
    For i = 1 To all_row_end Step 1
        If cells(i, 2) = cur Then
            If cells(i, 1) = pos Then
                If first_row = 0 Then
                    first_row = i
                    last_row = i
                Else
                    last_row = i
                End If
            End If
        End If
    Next
    
    '指定項目を指定方向にソート
    If up_or_down = "up" Then
        Worksheets("Sheet1").Range(cells(first_row, 1), cells(last_row, 4)) _
             .Sort Key1:=cells(first_row, 4), order1:=xlAscending
    End If
    If up_or_down = "down" Then
        Worksheets("Sheet1").Range(cells(first_row, 1), cells(last_row, 4)) _
             .Sort Key1:=cells(first_row, 4), order1:=xlDescending
    End If
    
    '指定項目の位置を切り出して先頭に挿入
    Rows(first_row & ":" & last_row).Cut
    Rows("1:1").Insert Shift:=xlShiftDown
    
    '指定項目の範囲を選択
    row_counts = last_row - first_row + 1
    Range(cells(1, 1), cells(row_counts, 4)).Select
    
End Sub

リストを昇順、降順にする関数がないため、今回のように1)ワークシート内に記入した内容でソートする、
以外だと、2)自分でソートを実装する、3).netのArraylistを利用する事になる。