【新発想】ノーコードでExcelを自動化する方法

VBAマクロ作成アプリ NoCodeVBA

MENU

2列を並び替えし、同じ値を横に並べる 

無料アプリで、すぐにエクセルVBAマクロを作成できます。

例として、「2列を並び替えし、同じ値を横に並べる 」VBAマクロを作成します。

(ページの末尾に、VBAコード掲載)

事例

A列とB列を、同じ値は横に並べて、並べ替えをします。

できました(^^)/

アプリの設定

アプリの設定です。

アプリのトップページ 

⇒▼フィルター・並べ替え

⇒【ツール】2列を並べ替えし、同じ値を横に並べる

【ポイント】

 元データの値は、変更を検証できるよう、変更前の状態です。

なお、並べ替えにより、書式がズレることがあります。

表示されるVBAコード 

アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。

Sub デモ_72() '2列を並べ替えし、同じ値を横に並べる
 
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止

Worksheets("Sheet1").Select
'現状を配列に退避
Dim 旧リスト左 As Variant, 旧リスト右 As Variant
旧リスト左 = Range(Range("a2"), Cells(Rows.Count, Range("a2").Column).End(xlUp)).Value
旧リスト右 = Range(Range("a2").Offset(0, 1), Cells(Rows.Count, Range("B2").Column).End(xlUp)).Value
'並び替え
Range(Range("a2"), Cells(Rows.Count, Range("a2").Column).End(xlUp)).Sort key1:=Range("a2"), order1:=xlAscending, Header:=xlNo
Range(Range("a2").Offset(0, 1), Cells(Rows.Count, Range("a2").Offset(0, 1).Column).End(xlUp)).Sort key1:=Range("a2").Offset(0, 1), order1:=xlAscending, Header:=xlNo
'◆リストに配列を入れる
Dim リスト左 As Variant, リスト右 As Variant
リスト左 = Range(Range("a2"), Cells(Rows.Count, Range("a2").Column).End(xlUp)).Value
リスト右 = Range(Range("a2").Offset(0, 1), Cells(Rows.Count, Range("a2").Offset(0, 1).Column).End(xlUp)).Value
'旧リストを戻す
Range("a2").Resize(UBound(旧リスト左, 1), 1) = 旧リスト左
Range("a2").Offset(0, 1).Resize(UBound(旧リスト右, 1), 1) = 旧リスト右
Erase 旧リスト左
Erase 旧リスト右
'◆値を転記
Dim リスト左行 As Long, リスト右行 As Long, リスト左値 As Variant, リスト右値 As Variant, セル左行 As Long, セル右行 As Long, i As Long
リスト左行 = 1
リスト右行 = 1
セル左行 = 0
セル右行 = 0
Worksheets("Sheet1").Select
Do
'リストの値を取得する
    リスト左値 = リスト左(リスト左行, 1)
    リスト右値 = リスト右(リスト右行, 1)
'リストの値を比較し、小さいほうをセルに入れ、リスト行に1を足す
    If リスト左値 = リスト右値 Then
        Range("d2").Offset(セル左行, 0) = リスト左値
        Range("d2").Offset(セル右行, 1).Value = リスト右値
        セル左行 = セル左行 + 1
        セル右行 = セル右行 + 1
        リスト左行 = リスト左行 + 1
        リスト右行 = リスト右行 + 1
    ElseIf リスト左値 < リスト右値 Then
        Range("d2").Offset(セル左行, 0).Value = リスト左値
        セル左行 = セル左行 + 1
        セル右行 = セル右行 + 1
        リスト左行 = リスト左行 + 1
    ElseIf リスト左値 > リスト右値 Then
        Range("d2").Offset(セル右行, 1).Value = リスト右値
        セル左行 = セル左行 + 1
        セル右行 = セル右行 + 1
        リスト右行 = リスト右行 + 1
    End If
'左右どちらかが、最後になったら、相手方の残りをセルに入れる
    If リスト左行 > UBound(リスト左, 1) Then
        For i = リスト右行 To UBound(リスト右, 1)
            Range("d2").Offset(セル左行, 1) = リスト右(i, 1)
            セル左行 = セル左行 + 1
        Next i
        Exit Do
    ElseIf リスト右行 > UBound(リスト右, 1) Then
        For i = リスト左行 To UBound(リスト左, 1)
            Range("d2").Offset(セル右行, 0) = リスト左(i, 1)
            セル右行 = セル右行 + 1
        Next i
        Exit Do
    End If
Loop
Application.DisplayAlerts = True   ' 警告表示を再開
Application.ScreenUpdating = True  ' 画面描画を再開
End Sub

マクロを使うメリット

手作業で数分かかる作業が、1秒で終わります。

ぜひ、アプリをご利用ください。

 

アプリはこちらから↓↓↓↓