Top > よくつかうプログラム> マクロの記録を使わない並び替えの部品

VBA通信教材申込み

VBA課題解決型実践塾セミナー内容

申込 ヤフーショッピング

マクロの記録を使わない並び替えの部品

(14)マクロの記録を使わない並び替えの部品

並び替えロジック
マクロの記録で作った並び替えを部品集に公開していますが、中身を理解せずに使っていると、困る時があります。
今回先頭行が並び変わっていない問題が発生しました。
集計をとった結果がうまくいかないので調べてみると原因がわかりました。
VBA実践塾の並び替えの部品は先頭行を使わない部品です。
先頭行を使わない範囲を設定しています。
エクセルで並び替えると先頭行を見出しとして使うにチェックが入っているかで変わってきます。
.Header = xlNoかxlYesを理解していれば問題ないのですが、マクロの記録を使わない部品を作りました。
少ないデータでは使えますが、大量データはスピードが遅いのでエクセルのソートを使ってください。

マクロの記録を使わない並び替えの部品

1つのキーの並び替え数字型

Sub 並び替え数字()
  Dim i As Long
  Dim j As Long
  Dim hikaku As Long
'並び替え前を後にコピーする
  For i = 2 To 9
    Cells(i, 2) = Cells(i, 1)
  Next
  For j = 8 To 2 Step -1
    For i = 2 To j
      If Cells(i, 2) > Cells(i + 1, 2) Then
        hikaku = Cells(i, 2)
        Cells(i, 2) = Cells(i + 1, 2)
        Cells(i + 1, 2) = hikaku
      End If
    Next
  Next
End Sub

マクロの記録を使わない並び替えの部品

マクロの記録を使わない並び替えの部品

1つのキーの並び替え文字型

Sub 並び替え文字()
  Dim i As Long
  Dim j As Long
  Dim hikaku As String
'並び替え前を後にコピーする
  For i = 2 To 9
    Cells(i, 5) = Cells(i, 4)
  Next
  For j = 8 To 2 Step -1
    For i = 2 To j
      If Cells(i, 5) > Cells(i+1, 5) Then
        hikaku = Cells(i, 5)
        Cells(i, 5) = Cells(i + 1, 5)
        Cells(i + 1, 5) = hikaku
      End If
    Next
  Next
End Sub

文字型・数字型キー混在の並び替え

Sub 複数キーの並び替え()
'並び替え前を後にコピーする
  Dim i As Long
  Dim j As Long
  Dim hikaku1 As String
  Dim hikaku2 As String
  Dim hikaku3 As String
  For i = 15 To 24
    For j = 1 To 4
      Cells(i, j + 5) = Cells(i, j)
    Next
  Next
  For j = 22 To 15 Step -1
    For i = 15 To j
      If Cells(i, 6) & Cells(i, 7) & Str(Cells(i, 9)) > Cells(i + 1, 6) & Cells(i + 1, 7) & Str(Cells(i + 1, 9)) Then
        hikaku1 = Cells(i, 6)
        hikaku2 = Cells(i, 7)
        hikaku3 = Str(Cells(i, 9))
        Cells(i, 6) = Cells(i + 1, 6)
        Cells(i, 7) = Cells(i + 1, 7)
        Cells(i, 8) = Cells(i + 1, 8)
        Cells(i, 9) = Cells(i + 1, 9)
        Cells(i + 1, 6) = hikaku1
        Cells(i + 1, 7) = hikaku2
        Cells(i + 1, 9) = Val(hikaku3)
      End If
    Next
  Next
End Sub

並び替え結果を別のシートに転記する

Sub 並び替え()
'並び替え前を後にコピーする
  Dim i As Long
  Dim j As Long
  Dim hikaku1 As String
  Dim hikaku2 As String
  Dim hikaku3 As String
  Dim lastrow As Long
  lastrow = Worksheets("mae").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 1 To lastrow
    For j = 1 To 4
      Worksheets("ato").Cells(i, j) = Worksheets("mae").Cells(i, j)
    Next
  Next
  For j = lastrow - 1 To 2 Step -1
    For i = 2 To j
      If Worksheets("ato").Cells(i, 1) & Worksheets("ato").Cells(i, 2) & Str(Worksheets("ato").Cells(i, 4)) > Worksheets("ato").Cells(i + 1, 1) & Worksheets("ato").Cells(i + 1, 2) & Str(Worksheets("ato").Cells(i + 1, 4)) Then
        hikaku1 = Worksheets("ato").Cells(i, 1)
        hikaku2 = Worksheets("ato").Cells(i, 2)
        hikaku3 = Str(Worksheets("ato").Cells(i, 4))
        Worksheets("ato").Cells(i, 1) = Worksheets("ato").Cells(i + 1, 1)
        Worksheets("ato").Cells(i, 2) = Worksheets("ato").Cells(i + 1, 2)
        Worksheets("ato").Cells(i, 3) = Worksheets("ato").Cells(i + 1, 3)
        Worksheets("ato").Cells(i, 4) = Worksheets("ato").Cells(i + 1, 4)
        Worksheets("ato").Cells(i + 1, 1) = hikaku1
        Worksheets("ato").Cells(i + 1, 2) = hikaku2
        Worksheets("ato").Cells(i + 1, 4) = Val(hikaku3)
      End If
    Next
  Next
  Worksheets("ato").Select
End Sub

1000件のデータを並び替えする

2分かかったので実用的ではない。100件の場合は2秒

マクロの記録を使わない並び替えの部品

Sub 並び替えtest()
'並び替え前を後にコピーする
  Dim i As Long
  Dim j As Long
  Dim hikaku1 As String
  Dim hikaku2 As String
  Dim hikaku3 As String
  Dim lastrow As Long
  lastrow = Worksheets("maetest").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 1 To lastrow
    For j = 1 To 4
      Worksheets("atotest").Cells(i, j) = Worksheets("maetest").Cells(i, j)
    Next
  Next
  For j = lastrow - 1 To 2 Step -1
    For i = 2 To j
      If Worksheets("atotest").Cells(i, 1) & Worksheets("atotest").Cells(i, 2) & Str(Worksheets("atotest").Cells(i, 4)) > Worksheets("atotest").Cells(i + 1, 1) & Worksheets("atotest").Cells(i + 1, 2) & Str(Worksheets("atotest").Cells(i + 1, 4)) Then
        hikaku1 = Worksheets("atotest").Cells(i, 1)
        hikaku2 = Worksheets("atotest").Cells(i, 2)
        hikaku3 = Str(Worksheets("atotest").Cells(i, 4))
        Worksheets("atotest").Cells(i, 1) = Worksheets("atotest").Cells(i + 1, 1)
        Worksheets("atotest").Cells(i, 2) = Worksheets("atotest").Cells(i + 1, 2)
        Worksheets("atotest").Cells(i, 3) = Worksheets("atotest").Cells(i + 1, 3)
        Worksheets("atotest").Cells(i, 4) = Worksheets("atotest").Cells(i + 1, 4)
        Worksheets("atotest").Cells(i + 1, 1) = hikaku1
        Worksheets("atotest").Cells(i + 1, 2) = hikaku2
        Worksheets("atotest").Cells(i + 1, 4) = Val(hikaku3)
      End If
    Next
  Next
  Worksheets("atotest").Select
End Sub

マクロの記録の部品を使うと1000件で1秒もかからない

Sub 並び替えマクロの記録()
'並び替え前を後にコピーする
  Dim i As Long
  Dim j As Long
  Dim hikaku1 As String
  Dim hikaku2 As String
  Dim hikaku3 As String
  Dim lastrow As Long
  lastrow = Worksheets("maetest").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 1 To lastrow
    For j = 1 To 4
    Worksheets("macro").Cells(i, j) = Worksheets("maetest").Cells(i, j)
    Next
  Next
  Worksheets("macro").Activate
  ActiveWorkbook.Worksheets("macro").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("macro").Sort.SortFields.Add Key:=Cells(2, 1), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  ActiveWorkbook.Worksheets("macro").Sort.SortFields.Add Key:=Cells(2, 2), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  ActiveWorkbook.Worksheets("macro").Sort.SortFields.Add Key:=Cells(2, 4), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("macro").Sort
    .SetRange Range(Cells(2, 1), Cells(lastrow, 4))
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
  Worksheets("macro").Select
End Sub

塾長あいさつ
基本方針(考え方)
通信教育内容
課題解決セミナー内容
初心者基礎コース内容
カリキュラム・料金
案内地図・各種リンク
問合せ・申込み
アベノ塾
システムの内製化
アサイコンピュータACS
応用部品集(有料)
販売管理(事例)
財務管理(事例)
顧客管理(事例)
見積もり(事例)
給与(事例)
介護(事例)
ゴースト暗算(事例)
部品集(部品の基礎)
部品集(シート関連)
部品集(データベース)
部品集(セル関連)
部品集(関数)
部品集(フォーム関連)
部品集(ブック関連)
部品集(その他)
変数の勉強
繰り返しと条件文
マスター登録.訂正.削除
フォルダー内のファイル
項目をシート名で作成
ブックの操作
CSVファイルの取り込み
呼び出し元・先
商品マスター検索
エクセル関数をVBAで
エクセル関数を使う
よくつかうプログラム
販売管理(ソース)
財務管理(ソース)
給与管理(概要・画面)
見積もり(概要・画面)
工程管理(概要・画面)
原価管理(概要・画面)