売上明細作成処理 シート作成

YouTube VBA

Sub Sheet_Clearに訂正がありますm(__)m
10.明細行の消去を見て下さい

金額計算

このようなデータの金額を計算してみましょう!

1件目の売上金額の計算プログラム

1件目は3行目から始まりますから、行は3、列7に計算結果を代入します

=は ← のイメージ

行を変数で表してみましょう!

この i の値が3から1ずつ増えていけばいいですね! 

繰り返し処理

ここで繰り返し処理をやってみましょう

For Nextステートメントは、同じ処理を繰り返し行うときに使います
カウンター変数初期値から終了値になるまで一連の処理を繰り返します

行目から32行目まで金額計算を繰り返します
For Nextの間で i の値3~32まで1ずつ増加します

店別に計算してみよう!

ABCストアの時のみ金額計算する
そうでない場合はなにもしない(今回はElse(条件が成立しないときの処理)はなし)

 

If Cells(i, 3) = “ABCストア” Then
Cells(i, 3)がABCストアの時のみ金額計算をする

店別に別表に取り出してみよう!


ABCストアの時、商品名~金額まで別表に書き出しましょう!

jは書き出す売上表の行の位置です
6から始まります1行書き出したら、
j=j+1 次に書き出す行の計算をします

どちらの辺も列が1ずつ増えて行っていますね!
こういう時はForNextが使えましたよね~



ForNextの中にForNextを入れます
入れ子あるいはネストと言います

変数を用意します
kは、項目の位置(列)を表します

For i=3to32 ~ Next i の中に、ForNext を書きます

★注意 j = j + 1の計算式は、このFor Nextの中に入れないでください
    jは書き出すデータの行位置を表しますから、入れてしまうと、
    1項目転記するたびに、行が加算されてしまいます

店名別に売上シートを作成してみよう!

各店のシートを先に作っておいてね!

上の表のB6セルに1番目の商品名が入りますが、
B6セルと言っても、どのシートのB6セルなのか 書く必要があります
売上明細シートにもB6セルがありますから…

セル情報の前にシート名を指定します
WorkSheets(“ABCストア”).Range(“B6”).Value

シート名は ” ” でくくる!

Worksheetsの最後のを忘れずに! 複数形にします

シートの選択

金額計算したい Cells(i, 7) = Cells(i, 5) * Cells(i, 6)等 のセルは、
売上明細シートのセルです
シート名が書かれていないセルは、今現在表示されているシートを参照します
ですので、他のシートが参照されている場合思いがけない結果となったりします

明確に売上明細シートを参照してほしいので、
WorkSheets(“売上明細”).Activate
または、WorkSheets(“売上明細”).Selectを加えます

Activateを加えることにより
シート名が書かれていないセルは、Activateされたシートのセルとみなされます

シートをアクティブにしないで、毎回指定する方法もあるけど…

このようになります

Withステートメント

Withステートメントを使って書くとこうなります

すべての店名別に売上シートを作成してみよう!

店名一覧シートを作成します

店名を取り出すプログラム

MsgBoxで店名を表示する部分
売上表作成プログラムに差し替えます

データの件数がわからない場合

今はデータの件数が30件とわかっているけど、
何件あるのかわからない あるいは どんどん増えて行く場合
最終行をいつものあれで解決しましょう!

For i = 3 To 32

i = 3 To .Cells(Rows.Count, 3).End(xlUp).Row

式が長いので、変数に代入してももちろんOKです
SaisyuGyo = .Cells(Rows.Count, 3).End(xlUp).Row
For i = 3 To SaisyuGyo

店名毎ループをやめる!

これまでは店名を基準に実行してきました
ABCストア 1~売上明細最終行
XYZスーパー 1~売上明細最終行


のように すべての店で最終行までループしていました

なぜこのようにしてきたかと言うと
各店ごとに売り上げ件数は異なるので、
各店の売上シートの最終行がわからなかったからです…

あら?

最終行って、求め方勉強したじゃん!?

このように変更します!

店名の判断も要りませんね!

Tenmei = .Cells(i, 3) :売上明細から店名取得

Worksheets(Tenmei).Activate :求めた店名シートをアクティブに!


j = Cells(Rows.Count, 2).End(xlUp).Row :求めた店名シートの売上表の最終行

明細行の消去

前に表示した、いらない明細を消去しましょう!
罫線は残したいので、ClearContentsを使います!

行単位の消去

行の選択

Rows(”行1:行2”).Select
行1~行2まで選択する

SelectClearContentsに変更する

6行目以降をすべて消去する場合
.Rows(“6:” & Rows.Count).ClearContents
Rows.Count…シートの最終行

動画では、6行目以降最終行まで消去するなら
.Rows(“6:” & .Cells(Rows.Count, 3).End(xlUp).Row) .ClearContents
としていますが、明細行がない場合、これでは見出しが消えてしまいます

これでは、データがない場合、見出しもClearされてしまう
.Rows(“6:” & .Cells(Rows.Count, 3).End(xlUp).Row).ClearContents
これは間違いです(^^;)

データがある場合のみ、Clearする
(5行目…見出し行) 
 
明細があるかどうかの判断が必要です
Gyo = .Cells(Rows.Count, 3).End(xlUp).Row
If Gyo > 5 Then .Rows(“6:” & Gyo).ClearContents
に変更してください!m(__)m

データのある範囲を消去

Sheet_Clear_Teisei() Or Sheet_Clear2()
売上明細シート作成プログラムの最初に加える

参考 2行ずらして消去

CurrentRegion & Offset を使えばデータの消去は簡単です
Range(“b4”).CurrentRegion.Offset(2, 0).ClearContents

CurrentRegion
Ctrl+Shift+*

Offset(2, 0)
2行下(店名と見出しを除く)に移動

この範囲を消去します

プログラムコード

すべてのプログラム

Option Explicit
Sub Uriage_Keisan0()

Cells(3, 7) = Cells(3, 5) * Cells(3, 6)     '1件目の金額計算
Cells(4, 7) = Cells(4, 5) * Cells(4, 6)     '2件目の金額計算
Cells(5, 7) = Cells(5, 5) * Cells(5, 6)     '3件目の金額計算
Cells(6, 7) = Cells(6, 5) * Cells(6, 6)     '4件目の金額計算
Cells(7, 7) = Cells(7, 5) * Cells(7, 6)     '5件目の金額計算

End Sub

Sub Uriage_Keisan0_1()
Dim i As Long   '売上データの行数
i = 3
Cells(i, 7) = Cells(i, 5) * Cells(i, 6)     '1件目の金額計算
i = i + 1
Cells(i, 7) = Cells(i, 5) * Cells(i, 6)     '2件目の金額計算
i = i + 1
Cells(i, 7) = Cells(i, 5) * Cells(i, 6)     '3件目の金額計算
i = i + 1
Cells(i, 7) = Cells(i, 5) * Cells(i, 6)     '4件目の金額計算
i = i + 1
Cells(i, 7) = Cells(i, 5) * Cells(i, 6)     '5件目の金額計算

'すべての計算式が同じ

End Sub

'Uriage_Keisan0_1をFor Nextを使って書き直してみましょう!
Sub Uriage_Keisan1()

Dim i As Long   '売上データの行数

For i = 3 To 32
    Cells(i, 7) = Cells(i, 5) * Cells(i, 6)     '金額計算
Next i

End Sub

'ABCストアのみ金額計算しましょう!
Sub Uriage_Keisan1_2()

Dim i As Long   '売上データの行数

For i = 3 To 32
    If Cells(i, 3) = "ABCストア" Then             '店名がABCストアかどうか
        Cells(i, 7) = Cells(i, 5) * Cells(i, 6)     'ABCストアのみ金額計算
    End If
Next i

End Sub

'ABCストアのみの売上表にしましょう!
Sub Uriage_Keisan2()
Dim i As Long   '売上データの行数
Dim j As Long   '作成する売上表の行数

j = 6
For i = 3 To 32
    Cells(i, 7) = Cells(i, 5) * Cells(i, 6)  '金額計算ここに移動しました
    If Cells(i, 3) = "ABCストア" Then       '店名がABCストアかどうか
        
        'ABCストアのみ売上表に転記
        Cells(j, 11) = Cells(i, 4)  '商品名
        Cells(j, 12) = Cells(i, 5)  '数量
        Cells(j, 13) = Cells(i, 6)  '単価
        Cells(j, 14) = Cells(i, 7)  '金額
        j = j + 1   '次に作成する売上表の行数の計算
        
    End If
Next i
End Sub

'Uriage_Keisan2を入れ子のForNextにしましょう!
Sub Uriage_Keisan3()
Dim i As Long   '売上データの行数
Dim j As Long   '作成する売上表の行数
Dim k As Long   '売上の項目の位置(列)

j = 6
For i = 3 To 32
    Cells(i, 7) = Cells(i, 5) * Cells(i, 6)  '金額計算
    If Cells(i, 3) = "ABCストア" Then       '店名がABCストアかどうか
             
        '売上表に転記
        For k = 4 To 7
            Cells(j, k + 7) = Cells(i, k)    '商品名~金額
        Next k
        j = j + 1   '次に作成する売上表の行数の計算
        
    End If
Next i
End Sub

'別シートに売上表を作成にしましょう!
Sub Uriage_Keisan4()
Dim i As Long   '売上データの行数
Dim j As Long   '作成する売上表の行数
Dim k As Long   '売上の項目の位置(列)

j = 6
For i = 3 To 32
    Cells(i, 7) = Cells(i, 5) * Cells(i, 6)  '金額計算
    If Cells(i, 3) = "ABCストア" Then       '店名がABCストアかどうか
          
        '売上表に転記
        For k = 4 To 7
            'ABCストアシートに売上表を作成します
            Worksheets("ABCストア").Cells(j, k - 2) = Cells(i, k)    '商品名~金額
        Next k
        j = j + 1 '次に作成する売上表の行数の計算
        
    End If
Next i
End Sub

'シートをアクティブにする
Sub Uriage_Keisan4_2()
Dim i As Long   '売上データの行数
Dim j As Long   '作成する売上表の行数
Dim k As Long   '売上の項目の位置(列)

'売上明細シートをアクティブに
Worksheets("売上明細").Activate
j = 6
For i = 3 To 32
    Cells(i, 7) = Cells(i, 5) * Cells(i, 6)  '金額計算
    If Cells(i, 3) = "ABCストア" Then       '店名がABCストアかどうか
          
        '売上表に転記
        For k = 4 To 7
            Worksheets("ABCストア").Cells(j, k - 2) = Cells(i, k)    '商品名~金額
        Next k
        j = j + 1 '次に作成する売上表の行数の計算
        
    End If
Next i
End Sub

'シートをアクティブにしないで、毎回指定してもいいけど…売上明細、売上明細うるさいよね!
Sub Uriage_Keisan5()
Dim i As Long   '売上データの行数
Dim j As Long   '作成する売上表の行数
Dim k As Long   '売上の項目の位置(列)

j = 6
For i = 3 To 32
    Worksheets("売上明細").Cells(i, 7) = _
        Worksheets("売上明細").Cells(i, 5) * Worksheets("売上明細").Cells(i, 6)  '金額計算
    If Worksheets("売上明細").Cells(i, 3) = "ABCストア" Then       '店名がABCストアかどうか
          
        '売上表に転記
        For k = 4 To 7
            Worksheets("ABCストア").Cells(j, k - 2) = Worksheets("売上明細").Cells(i, k)    '商品名~金額
        Next k
        j = j + 1 '次に作成する売上表の行数の計算
        
    End If
Next i
End Sub

'Uriage_Keisan5をWithステートメントを使って
Sub uriage_keisan6()
Dim i As Long   '売上データの行数
Dim j As Long   '作成する売上表の行数
Dim k As Long   '売上の項目の位置(列)

With Worksheets("売上明細")
    j = 6
    For i = 3 To 32
        .Cells(i, 7) = .Cells(i, 5) * .Cells(i, 6)  '金額計算
        If .Cells(i, 3) = "ABCストア" Then       '店名がABCストアかどうか
              
            '売上表に転記
            For k = 4 To 7
                Worksheets("ABCストア").Cells(j, k - 2) = .Cells(i, k)    '商品名~金額
            Next k
            j = j + 1 '次に作成する売上表の行数の計算
            
        End If
    Next i
End With

End Sub

'店名一覧シートから店名を取り出す
Sub Uriage_Keisan7()
Dim Tenmei  As String   '作成する店名 文字列
Dim Tenmei_No As Long   '店名一覧の行数

For Tenmei_No = 3 To 7

    Tenmei = Worksheets("店名一覧").Cells(Tenmei_No, 2)  '店名の獲得
    MsgBox "店名は " & Tenmei
    
Next Tenmei_No
End Sub

'Uriage_Keisan7のMsgBoxの代わりに売上表作成プログラムをコピー
'すべての店名で作成できるように変更
Sub Uriage_Keisan8()
Dim Tenmei  As String   '作成する店名 文字列
Dim Tenmei_No As Long   '店名一覧の行数
Dim i As Long   '売上データの行数
Dim j As Long   '作成する売上表の行数
Dim k As Long   '売上の項目の位置(列)

With Worksheets("売上明細")
    For Tenmei_No = 3 To 7
        Tenmei = Worksheets("店名一覧").Cells(Tenmei_No, 2)
        
        'MsgBoxの代わりに ここから
        j = 6
        For i = 3 To 32
            .Cells(i, 7) = .Cells(i, 5) * .Cells(i, 6)     '金額計算
            'If .Cells(i, 3) = "ABCストア" Then       '店名がABCストアかどうか
            If .Cells(i, 3) = Tenmei Then        '店名がTenmei かどうか
                 
                '売上表に転記
                For k = 4 To 7
                    'Worksheets("ABCストア").Cells(j, k - 2) = .Cells(i, k)    '商品名~金額
                    Worksheets(Tenmei).Cells(j, k - 2) = .Cells(i, k)         '商品名~金額
                Next k
                j = j + 1 '次に作成する売上表の行数の計算
                
            End If
        Next i
        'ここまで入れる
        
    Next Tenmei_No
End With

End Sub

'最終行の指定
Sub Uriage_Keisan9()
Dim Tenmei  As String   '作成する店名 文字列
Dim Tenmei_No As Long   '店名一覧の行数
Dim i As Long   '売上データの行数
Dim j As Long   '作成する売上表の行数
Dim k As Long   '売上の項目の位置(列)

With Worksheets("売上明細")
    For Tenmei_No = 3 To 7
        Tenmei = Worksheets("店名一覧").Cells(Tenmei_No, 2)
        
        'MsgBoxの代わりに ここから
        j = 6
        For i = 3 To .Cells(Rows.Count, 3).End(xlUp).Row  '最終行の式に置き換え
            .Cells(i, 7) = .Cells(i, 5) * .Cells(i, 6)     '金額計算
            If .Cells(i, 3) = Tenmei Then        '店名がTenmei かどうか
                 
                '売上表に転記
                For k = 4 To 7
                    Worksheets(Tenmei).Cells(j, k - 2) = .Cells(i, k)     '商品名~金額
                Next k
                j = j + 1 '次に作成する売上表の行数の計算
                
            End If
        Next i
        'ここまで入れる
        
    Next Tenmei_No
End With

End Sub

' 最終行を式に代入して使う
Sub Uriage_Keisan10()
Dim Tenmei  As String   '作成する店名 文字列
Dim Tenmei_No As Long   '店名一覧の行数
Dim i As Long   '売上データの行数
Dim j As Long   '作成する売上表の行数
Dim k As Long   '売上の項目の位置(列)
Dim SaisyuGyo As Long '売上データの最終行

With Worksheets("売上明細")

    SaisyuGyo = .Cells(Rows.Count, 3).End(xlUp).Row
    MsgBox "最終行は… " & SaisyuGyo
    
    For Tenmei_No = 3 To 7
        Tenmei = Worksheets("店名一覧").Cells(Tenmei_No, 2)
        
        'MsgBoxの代わりに ここから
        j = 6
        
        For i = 3 To SaisyuGyo
            .Cells(i, 7) = .Cells(i, 5) * .Cells(i, 6)     '金額計算
            If .Cells(i, 3) = Tenmei Then        '店名がTenmei かどうか
                 
                '売上表に転記
                For k = 4 To 7
                    Worksheets(Tenmei).Cells(j, k - 2) = .Cells(i, k)     '商品名~金額
                Next k
                j = j + 1
                
            End If
        Next i
        'ここまで入れる
        
    Next Tenmei_No
End With

End Sub

'店名毎ループをやめる!
Sub Uriage_Keisan11()
Dim Tenmei  As String   '作成する店名 文字列
Dim i As Long                '売上データの行数
Dim j As Long                '作成する売上表の行数
Dim k As Long               '売上の項目の位置(列)
Dim SaisyuGyo As Long  '売上データの最終行

With Worksheets("売上明細")

    SaisyuGyo = .Cells(Rows.Count, 3).End(xlUp).Row  'データの最終行
        
    For i = 3 To SaisyuGyo
        .Cells(i, 7) = .Cells(i, 5) * .Cells(i, 6)     '金額計算
        Tenmei = .Cells(i, 3)
             
            '売上表に転記
            Worksheets(Tenmei).Activate                  '求めた店名シートをアクティブに!
            j = Cells(Rows.Count, 2).End(xlUp).Row  '求めた店名シートの売上表の最終行
            For k = 4 To 7
                Cells(j + 1, k - 2) = .Cells(i, k)   '商品名~金額 最終行の次に書き出し
            Next k
            
    Next i
        
End With

Worksheets("売上明細").Activate  '売上シートをアクティブにして終わる

End Sub

'店名毎ループをやめる!これでもOK!
Sub Uriage_Keisan11_2()
Dim Tenmei  As String   '作成する店名 文字列
Dim i As Long                '売上データの行数
Dim j As Long                '作成する売上表の行数
Dim k As Long               '売上の項目の位置(列)
Dim SaisyuGyo As Long  '売上データの最終行

With Worksheets("売上明細")

    SaisyuGyo = .Cells(Rows.Count, 3).End(xlUp).Row  'データの最終行
        
    For i = 3 To SaisyuGyo
        .Cells(i, 7) = .Cells(i, 5) * .Cells(i, 6)     '金額計算
        Tenmei = .Cells(i, 3)
             
            '売上表に転記
            'Worksheets(Tenmei).Activate                  '求めた店名シートをアクティブにしないでセルの前に指定する方法
            j = Worksheets(Tenmei).Cells(Rows.Count, 2).End(xlUp).Row  '求めた店名シートの売上表の最終行
            For k = 4 To 7
                Worksheets(Tenmei).Cells(j + 1, k - 2) = .Cells(i, k)   '商品名~金額 最終行の次に書き出し
            Next k
            
    Next i
        
End With
'売上シートから実行する場合はなくてもOK!
'Worksheets("売上明細").Activate  '売上シートをアクティブにして終わる

End Sub

Sub Sheet_Row()
    Worksheets("売上明細").Activate
    '6行目から10行目まで選択
    Rows("6:10").Select
End Sub

'最終行にどんどん追加されてしまうので、行単位で前のデータを消去する
'このSheet_Clear()間違いです
Sub Sheet_Clear()

Dim Tenmei  As String   '作成する店名 文字列
Dim Tenmei_No As Long   '店名一覧の行数

    For Tenmei_No = 3 To 7
    
        Tenmei = Worksheets("店名一覧").Cells(Tenmei_No, 2)
        With Worksheets(Tenmei) 'Temeiシートの
        
            '6行目以降をすべて消去
           '.Rows("6:" & Rows.Count).ClearContents     'Rows.Count…シートの最終行
          '*****************************************************
            'このClearContents間違いです
            
            '6行目以降最終行まで消去するなら
           .Rows("6:" & .Cells(Rows.Count, 3).End(xlUp).Row) _
           .ClearContents       'データの消去 罫線は残る
           '↑ 明細行がない場合、これでは見出しが消えてしまうm(__)m
            '*****************************************************
        End With
    Next Tenmei_No
    
End Sub

'最終行にどんどん追加されてしまうので、行単位で前のデータを消去する
'こちらを使ってください
Sub Sheet_Clear_Teisei()

Dim Tenmei  As String   '作成する店名 文字列
Dim Tenmei_No As Long   '店名一覧の行数
Dim Gyo As Long              'シートの最終行

    For Tenmei_No = 3 To 7
    
        Tenmei = Worksheets("店名一覧").Cells(Tenmei_No, 2)
        With Worksheets(Tenmei) 'Temeiシートの
        
            '6行目以降をすべて消去
           '.Rows("6:" & Rows.Count).ClearContents     'Rows.Count…シートの最終行
           '*****************************************************
            '6行目以降最終行まで消去するなら
            Gyo = .Cells(Rows.Count, 3).End(xlUp).Row
             'データがない場合、見出しもClearされてしまうので
            
             If Gyo > 5 Then         '5行目…見出し行
                'データがある場合のみ、Clearする
                .Rows("6:" & Gyo).ClearContents        'データの消去 罫線は残る
             End If
             '*****************************************************
        End With
    Next Tenmei_No
    
End Sub

'行単位でなく、データのある範囲を消去する
Sub Sheet_Clear2()
Dim Tenmei  As String      '作成する店名 文字列
Dim Tenmei_No As Long   '店名一覧の行数
Dim Gyo As Long              'シートの最終行
    
    For Tenmei_No = 3 To 7
    
        Tenmei = Worksheets("店名一覧").Cells(Tenmei_No, 2)
        With Worksheets(Tenmei)
            
            Gyo = .Cells(Rows.Count, 2).End(xlUp).Row
            
            'データがない場合、見出しもClearされてしまうので
            If Gyo > 5 Then         '5行目…見出し行
                 'データがある場合のみ、Clearする
                .Range("b6", .Cells(Gyo, 5)).ClearContents  '6行目から最終行まで表の範囲を消去
            End If
        End With
        
    Next Tenmei_No
     
End Sub


Sub CROffset()
'B6を含むCurrentRegionを2行下に移動しその範囲を消去
 Range("b6").CurrentRegion.Offset(2, 0).ClearContents
End Sub

完成バージョンです

'店名毎ループをやめる!
Sub Uriage_Keisan_Kansei()
Dim Tenmei  As String   '作成する店名 文字列
Dim i As Long                '売上データの行数
Dim j As Long                '作成する売上表の行数
Dim k As Long               '売上の項目の位置(列)
Dim SaisyuGyo As Long  '売上データの最終行

'Application.ScreenUpdating = False  '画面の更新を止める
                                                      'ちらつき防止

Call Sheet_Clear_Teisei                                '全店名別シートのClearを加える

With Worksheets("売上明細")

    SaisyuGyo = .Cells(Rows.Count, 3).End(xlUp).Row  'データの最終行
        
    For i = 3 To SaisyuGyo
        .Cells(i, 7) = .Cells(i, 5) * .Cells(i, 6)     '金額計算
        Tenmei = .Cells(i, 3)
             
            '売上表に転記
            Worksheets(Tenmei).Activate                  '求めた店名シートをアクティブに!
            j = Cells(Rows.Count, 2).End(xlUp).Row  '求めた店名シートの売上表の最終行
            For k = 4 To 7
                Cells(j + 1, k - 2) = .Cells(i, k)   '商品名~金額 最終行の次に書き出し
            Next k
            
    Next i
        
End With

Worksheets("売上明細").Activate  '売上シートをアクティブにして終わる

'Application.ScreenUpdating = True  '画面の更新を再開する

End Sub

'店名毎ループをやめる!これでもOK!
Sub Uriage_Keisan_Kansei2()
Dim Tenmei  As String   '作成する店名 文字列
Dim i As Long                '売上データの行数
Dim j As Long                '作成する売上表の行数
Dim k As Long               '売上の項目の位置(列)
Dim SaisyuGyo As Long  '売上データの最終行

'Application.ScreenUpdating = False  '画面の更新を止める
                                                      'ちらつき防止

Call Sheet_Clear_Teisei                                '全店名別シートのClearを加える

With Worksheets("売上明細")

    SaisyuGyo = .Cells(Rows.Count, 3).End(xlUp).Row  'データの最終行
        
    For i = 3 To SaisyuGyo
        .Cells(i, 7) = .Cells(i, 5) * .Cells(i, 6)     '金額計算
        Tenmei = .Cells(i, 3)
             
            '売上表に転記
            'Worksheets(Tenmei).Activate                  '求めた店名シートをアクティブにしないでセルの前に指定する方法
            j = Worksheets(Tenmei).Cells(Rows.Count, 2).End(xlUp).Row  '求めた店名シートの売上表の最終行
            For k = 4 To 7
                Worksheets(Tenmei).Cells(j + 1, k - 2) = .Cells(i, k)   '商品名~金額 最終行の次に書き出し
            Next k
            
    Next i
        
End With

'売上シートから実行する場合はなくてもOK!
'Worksheets("売上明細").Activate  '売上シートをアクティブにして終わる

'Application.ScreenUpdating = True  '画面の更新を再開する

End Sub

'最終行にどんどん追加されてしまうので、行単位で前のデータを消去する
'こちらを使ってください
Sub Sheet_Clear_Teisei()

Dim Tenmei  As String   '作成する店名 文字列
Dim Tenmei_No As Long   '店名一覧の行数
Dim Gyo As Long              'シートの最終行

    For Tenmei_No = 3 To 7
    
        Tenmei = Worksheets("店名一覧").Cells(Tenmei_No, 2)
        With Worksheets(Tenmei) 'Temeiシートの
        
            '6行目以降をすべて消去
           '.Rows("6:" & Rows.Count).ClearContents     'Rows.Count…シートの最終行
           '*****************************************************
            '6行目以降最終行まで消去するなら
            Gyo = .Cells(Rows.Count, 3).End(xlUp).Row
             'データがない場合、見出しもClearされてしまうので
            
             If Gyo > 5 Then         '5行目…見出し行
                'データがある場合のみ、Clearする
                .Rows("6:" & Gyo).ClearContents        'データの消去 罫線は残る
             End If
             '*****************************************************
        End With
    Next Tenmei_No
    
End Sub

'行単位でなく、データのある範囲を消去する
Sub Sheet_Clear2()
Dim Tenmei  As String      '作成する店名 文字列
Dim Tenmei_No As Long   '店名一覧の行数
Dim Gyo As Long              'シートの最終行
    
    For Tenmei_No = 3 To 7
    
        Tenmei = Worksheets("店名一覧").Cells(Tenmei_No, 2)
        With Worksheets(Tenmei)
            
            Gyo = .Cells(Rows.Count, 2).End(xlUp).Row
            
            'データがない場合、見出しもClearされてしまうので
            If Gyo > 5 Then         '5行目…見出し行
                 'データがある場合のみ、Clearする
                .Range("b6", .Cells(Gyo, 5)).ClearContents  '6行目から最終行まで表の範囲を消去
            End If
        End With
        
    Next Tenmei_No
     
End Sub

コメント