Excel VBAを使用して降順と昇順でデータを並べ替える

Question

私は、SolidWorksインターフェイスで選択された各行の単位ベクトルの値をエクスポートするVBAマクロを作成していますが、それがExcelに書き込まれる前に私はExcelの範囲B2をD2に分類する必要があります（B2は部分ベクトルの部分iを表し、C2は部分jを表し、D2は部分kを表します）。範囲は選択された行の数に依存します。選択された各行はベクトルを表し、各ベクトルはExcelの行を表します。

列Dでソートして、セルD2の最大値、セルD3の最小値でソートし、そこから昇順に並べ替える必要があります。最初は上がり、次に2番目の行から降りる。

選択した4本のラインがあったのであれば、D列には、次のようになります。

-0.99221 -1 -0.99789 -0.99664

現在、それは次のようになります。

Excel screenshot

しかし、最初にソートする必要があった行の数はわかりません。関連するコードは次のとおりです。

Dim r As Long 
Dim ws As Worksheet 
Set ws = ActiveSheet 

For q = 3 To NumberOfSelectedItems 
Columns("B:D").Sort key1:=Range("D2:D2"), order1:=xlDescending, Header:=xlYes 
r = ws.Cells(ws.Rows.Count, 4).End(xlUp).Rows 
Range("B3:D2" & r).Sort key1:=Range("D2:D2"), order1:=xlAscending, Header:=xlNo 
bRes = WriteToExcel(((q - 1) * 1) + 1, vModelSelPt4, "Unit Vector") 
Next 

現在のところ、このコードでは1004エラーが表示されます。私はそれが間違っているが、確かではない小さなものだと思う。上記の順序でD列でどのように注文すればよいですか？

Private Function WriteToExcel(startRow As Integer, data As Variant, Optional label As String = "") As Boolean 

    'get the results into excel 

    With xlWorkbook.ActiveSheet 
     .Cells(startRow + 2, 2).Value = data(0) 
     .Cells(startRow + 2, 3).Value = data(1) 
     .Cells(startRow + 2, 4).Value = data(2) 
    End With 
End Function 

上記のコードは、Excelにデータを書き込む機能です。それは非常に重要です。これはSolidWorks APIで行われているため、構文は少し異なります。

Answer 1

お客様の質問に投稿された行のうち、私はあなたのカスタム関数WriteToExcel（あなたのコードサンプルには含まれていなかったため、無関係とみなされます）を除いてエラーが表示されませんでした。

この機能でエラーが発生しない限り、上記のコードは問題なく動作します。

並べ替えの場合は、列Dを昇順に並べ替え、並べ替えられた表の行（列Dの最大値を含む）を表の下部から上部に移動することをお勧めします。次subはまさにそれを行います。

Option Explicit 

Public Sub SortIt() 

Dim lngLastRow As Long 

With ThisWorkbook.Worksheets(1) 
    lngLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row 
    With .Sort 
     .SortFields.Clear 
     .SortFields.Add Key:=Range("D2:D" & lngLastRow), _ 
      SortOn:=xlSortOnValues, Order:=xlAscending 
     .SetRange Range("A1:D" & lngLastRow) 
     .Header = xlYes 
     .Apply 
    End With 
    .Range("A2:D" & lngLastRow).Copy Destination:=Range("A3") 
    .Range(.Cells(lngLastRow + 1, 1), .Cells(lngLastRow + 1, 4)).Cut _ 
     Destination:=Range("A2") 
End With 

End Sub 

注意を、上記のコードは、それは、あなたがコードを調整すべき場合ではない場合はシート1上にあるように、テーブルを前提としていること。ご質問やご不明な点がございましたら教えてください。

編集：[コピー]コマンドを[切り取り]に変更しました。