レッスン-投稿一覧パソコン仕事５倍塾ポータル

投稿/コメントを表示します。

浦山大さんの投稿

(投稿ID: 3506)

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

2017/10/13 19:04

小川慶一さんのコメント

(コメントID: 4976)

浦山大さん:

添削を返送します。

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

2017/10/15 21:24