エクセルマクロ オンライン講座コメント紹介

コメント紹介
   └ 解説「伝票作成マクロ」
       └ 重複しないリストを作成する(並べ替えを行い、最後に元に戻す)

重複しないリストを作成する(並べ替えを行い、最後に元に戻す)

[9050] 2017-10-13 10:04:46 浦山大さんからの投稿です。

Zentaiというプロシージャに処理をまとめました。
確認の意味で一度見て頂けると嬉しいです。
部分部分は問題ないと思います(ちゃんと動きました)。

・インデントの位置は大丈夫でしょうか?
・一つひとつ細切れにしてチェックしながら取り組めました。
 →いつも先生の仰っているパーツごとに細かく…の意味がとてもよ  くわかりました。実務でも使えそうです。
・早速、実務で作成した長いマクロも整理していきたいと思います。

Option Explicit

Dim ws As Worksheet
Dim cCo, cMx, cMigi As Long 'よくコメントで纏めてあるのを見かけるのでやってみました、問題なく動く
Dim namae As String     '別解、理解できました、使えてます。

Sub Zentai()
    Set ws = Worksheets("main")     '見本と"main"2枚なので明示
    cMx = Range("B" & ws.Rows.Count).End(xlUp).Row
    cCo = 2
    cMigi = 2
        Tooshibanngou   '通番を振る
    cCo = 2     'プロシージャ内で設定し直す方がスマートなんですか?
        Narabekae_B     'B列で並べ替える
        Create_List         'リストを作成する
    cCo = 2     'プロシージャ内で設定し直す方がスマートなんですか?
        Narabekae_A     'A列で並べ替える(並び順を元に戻す)
        Sakujo_Tooshibangou '通番を削除する、これで元通り
End Sub

Sub Tooshibanngou()
    For cCo = 2 To cMx
        ws.Range("A" & cCo).Value = cCo - 1
    Next
End Sub

Sub Narabekae_B()
    With ws
    .Sort.SortFields.Clear
    .Sort.SortFields.Add _
        Key:=Range("B1"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:B" & cMx)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub

Sub Create_List()
    For cCo = 2 To cMx
        If ws.Range("B" & cCo) <> namae Then
            namae = ws.Range("B" & cCo).Value
            ws.Range("D" & cMigi).Value = cMigi - 1
            ws.Range("E" & cMigi).Value = namae
            cMigi = cMigi + 1
        End If
    Next
End Sub

Sub Narabekae_A()
    With ws
    .Sort.SortFields.Clear
    .Sort.SortFields.Add _
        Key:=Range("A1"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:B" & cMx)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub

Sub Sakujo_Tooshibangou()
    ws.Range("A2:A" & cMx).ClearContents
End Sub

 


[9059] 2017-10-15 12:24:43 小川慶一さんからの投稿です。

浦山大さん:

添削を返送します。
Option Explicit
 
Dim ws As Worksheet
'Dim cCo, cMx, cMigi As Long 'よくコメントで纏めてあるのを見かけるのでやってみました、問題なく動く
Dim cCo As Long, cMx As Long, cMigi As Long '←vb6.0では、都度型指定が必要
Dim namae As String     '別解、理解できました、使えてます。
 
Sub Zentai()
    Set ws = Worksheets("main")     '見本と"main"2枚なので明示
    cMx = Range("B" & ws.Rows.Count).End(xlUp).Row
    cCo = 2
    cMigi = 2
        '↓インデント不正
        Tooshibanngou   '通番を振る
    cCo = 2     'プロシージャ内で設定し直す方がスマートなんですか?
        '↓インデント不正
        Narabekae_B     'B列で並べ替える
        Create_List         'リストを作成する
    cCo = 2     'プロシージャ内で設定し直す方がスマートなんですか?
        '↓インデント不正
        Narabekae_A     'A列で並べ替える(並び順を元に戻す)
        Sakujo_Tooshibangou '通番を削除する、これで元通り
End Sub
 
Sub Tooshibanngou()
    'autofillも試してみましょう
    For cCo = 2 To cMx
        ws.Range("A" & cCo).Value = cCo - 1
    Next
End Sub
 
Sub Narabekae_B()
    With ws
        '↓インデント不正
'    .Sort.SortFields.Clear
'    .Sort.SortFields.Add _
'        Key:=Range("B1"), _
'        SortOn:=xlSortOnValues, _
'        Order:=xlAscending, _
'        DataOption:=xlSortNormal
    
        .Sort.SortFields.Clear
        .Sort.SortFields.Add _
            Key:=Range("B1"), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:B" & cMx)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub
 
Sub Create_List()
    For cCo = 2 To cMx
        If ws.Range("B" & cCo) <> namae Then
            namae = ws.Range("B" & cCo).Value
            ws.Range("D" & cMigi).Value = cMigi - 1
            ws.Range("E" & cMigi).Value = namae
            cMigi = cMigi + 1
        End If
    Next
End Sub

'Narabekae_B参照のこと
Sub Narabekae_A()
    With ws
    .Sort.SortFields.Clear
    .Sort.SortFields.Add _
        Key:=Range("A1"), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A1:B" & cMx)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub
 
Sub Sakujo_Tooshibangou()
    ws.Range("A2:A" & cMx).ClearContents
End Sub

 


まずはここから!スマホでも学べる無料動画講座

今なら先着30名限定で無料!定価4,800円の、初心者のためのエクセルマクロ動画講座。
  1. Excel 97~Excel 2016まですべて対応。動画本数20本、総再生時間2時間44分53秒
  2. PC, Mac, iPhone, iPad, Androidのお好みの環境で、いつでも好きなときに学べます。
2004年から10年間述べ3,000名以上に実施した研修の経験と実績を集約した講座です。
いますぐ無料で試してください。

トップへ