金額検討に使えるマクロまとめ

# パイプを売るためのマクロをまとめる
下記の続編です。

https://qiita.com/anya9999/items/5cd0c17dfaa18101e2c7

私が後でコピペするための記事です。
パイプを売る方は少ないと思いますが、ご自身の業務に合わせてアレンジしてお使いください。

### （１）材料単価表作成
```
Sub Macro1()
'材料単価表の作成

    '小見出し
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "材質"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "サイズ"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "4m単価"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "1mm単価"
    
    'VP
    Range("P3").Select
    ActiveCell.FormulaR1C1 = "VP"
    Range("Q3").Select
    ActiveCell.FormulaR1C1 = "100"
    Range("R3").Select
    ActiveCell.FormulaR1C1 = "5290"
   
    Range("P4").Select
    ActiveCell.FormulaR1C1 = "VP"
    Range("Q4").Select
    ActiveCell.FormulaR1C1 = "75"
    Range("R4").Select
    ActiveCell.FormulaR1C1 = "3599"
    
    Range("P5").Select
    ActiveCell.FormulaR1C1 = "VP"
    Range("Q5").Select
    ActiveCell.FormulaR1C1 = "65"
    Range("R5").Select
    ActiveCell.FormulaR1C1 = "2345"
        
    Range("P6").Select
    ActiveCell.FormulaR1C1 = "VP"
    Range("Q6").Select
    ActiveCell.FormulaR1C1 = "50"
    Range("R6").Select
    ActiveCell.FormulaR1C1 = "1840"
    
    'HTVP
    Range("P7").Select
    ActiveCell.FormulaR1C1 = "HTVP"
    Range("Q7").Select
    ActiveCell.FormulaR1C1 = "25"
    Range("R7").Select
    ActiveCell.FormulaR1C1 = "1877"
    
    Range("P8").Select
    ActiveCell.FormulaR1C1 = "HTVP"
    Range("Q8").Select
    ActiveCell.FormulaR1C1 = "40"
    Range("R8").Select
    ActiveCell.FormulaR1C1 = "3384"
    
    'FSVP
    Range("P9").Select
    ActiveCell.FormulaR1C1 = "FSVP"
    Range("Q9").Select
    ActiveCell.FormulaR1C1 = "50"
    Range("R9").Select
    ActiveCell.FormulaR1C1 = "2912"
    
    Range("P10").Select
    ActiveCell.FormulaR1C1 = "FSVP"
    Range("Q10").Select
    ActiveCell.FormulaR1C1 = "65"
    Range("R10").Select
    ActiveCell.FormulaR1C1 = "4020"
    
    Range("P11").Select
    ActiveCell.FormulaR1C1 = "FSVP"
    Range("Q11").Select
    ActiveCell.FormulaR1C1 = "75"
    Range("R11").Select
    ActiveCell.FormulaR1C1 = "4836"
    
    Range("P12").Select
    ActiveCell.FormulaR1C1 = "FSVP"
    Range("Q12").Select
    ActiveCell.FormulaR1C1 = "100"
    Range("R12").Select
    ActiveCell.FormulaR1C1 = "7044"
    
    Range("P13").Select
    ActiveCell.FormulaR1C1 = "ｶﾗｰVP"
    Range("Q13").Select
    ActiveCell.FormulaR1C1 = "75"
    Range("R13").Select
    ActiveCell.FormulaR1C1 = "5675"
        
    Range("P14").Select
    ActiveCell.FormulaR1C1 = "ｶﾗｰVP"
    Range("Q14").Select
    ActiveCell.FormulaR1C1 = "100"
    Range("R14").Select
    ActiveCell.FormulaR1C1 = "8465"

    '1mm単価出し
    Range("S3").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]/4000"
    Range("S3").Select
    Selection.Copy
    Range("S4:S14").Select
    ActiveSheet.Paste
    
    Application.CutCopyMode = False
End Sub
```

### （２）金額計算
```
Sub Macro2_1()
'１部屋ごとにメートル寸法からミリ寸法へ直す

    '最終列を取得し、最終列まで繰り返す
    '1 → A列が対象
    Dim i
    For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row

        '左横の列のメートル寸法をミリに変換、ヤトイは400に置換
        'Cells(i, 4)の部分を変更して計算結果を表示する列を決定、7→G列
        Cells(i, 8) = "=IFERROR(RC[-2]*1000,400)"
    
        ' Cells(i, 8)が400の場合、セルの色を変える
        If Cells(i, 8) = 400 Then
            ' 灰色
            Cells(i, 8).Interior.Color = RGB(230, 230, 230)
        End If

    Next
    
End Sub
```
```
Sub Macro2_2()
'小計・材料費
    
    '小計
    Range("I3").Select
    ActiveCell.FormulaR1C1 = "=INT(RC[1]+RC[2])"
    
    '材料費
    Range("J3").Select
    ActiveCell.FormulaR1C1 = "=INT(RC[-2]*RC[2])"
    
    '複製
    Range("I3:J3").Select
    Selection.Copy
    
        '最終列を取得し、最終列まで繰り返す
        Dim i
        For i = 3 To Cells(Rows.Count, 6).End(xlUp).Row
            Cells(i, 9).Select
            ActiveSheet.Paste
        Next
        
        Application.CutCopyMode = False
        Range("K1").Select
    
End Sub
```
```
Sub Macro2_3()
'工費を代入

    '最終列を取得し、最終列まで繰り返す
    Dim i
    For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
    '75A以上は650円
        If Cells(i, 5) >= 75 Then
            Cells(i, 11) = 650
    '65A以下は600円
        Else
            Cells(i, 11) = 600
        End If
    Next

End Sub
```
```
Sub Macro2_4()
'材料費単価を代入

    '最終列を取得し、最終列まで繰り返す
    Dim i
    For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
    
            'VP
            If Cells(i, 4) = "VP" And Cells(i, 5) = 100 Then
            Cells(i, 12) = Cells(3, 19)
            ElseIf Cells(i, 4) = "VP" And Cells(i, 5) = 75 Then
            Cells(i, 12) = Cells(4, 19)
            ElseIf Cells(i, 4) = "VP" And Cells(i, 5) = 65 Then
            Cells(i, 12) = Cells(5, 19)
            ElseIf Cells(i, 4) = "VP" And Cells(i, 5) = 50 Then
            Cells(i, 12) = Cells(6, 19)

            'HTVP
            ElseIf Cells(i, 4) = "HTVP" And Cells(i, 5) = 40 Then
            Cells(i, 12) = Cells(7, 19)
            ElseIf Cells(i, 4) = "HTVP" And Cells(i, 5) = 25 Then
            Cells(i, 12) = Cells(8, 19)

            'FSVP
            ElseIf Cells(i, 4) = "FSVP" And Cells(i, 5) = 100 Then
            Cells(i, 12) = Cells(9, 19)
            ElseIf Cells(i, 4) = "FSVP" And Cells(i, 5) = 75 Then
            Cells(i, 12) = Cells(10, 19)
            ElseIf Cells(i, 4) = "FSVP" And Cells(i, 5) = 65 Then
            Cells(i, 12) = Cells(11, 19)
            ElseIf Cells(i, 4) = "FSVP" And Cells(i, 5) = 50 Then
            Cells(i, 12) = Cells(12, 19)

            'ｶﾗｰVP
            ElseIf Cells(i, 4) = "ｶﾗｰVP" And Cells(i, 5) = 100 Then
            Cells(i, 12) = Cells(13, 19)
            ElseIf Cells(i, 4) = "ｶﾗｰVP" And Cells(i, 5) = 75 Then
            Cells(i, 12) = Cells(14, 19)

            End If
            
    Next

End Sub
```
### （３）黒塗りのある列のデータを削除
```
Sub Macro3()
'黒塗りがある列のデータを削除
'下からループするとなぜかうまくいく
Dim i
For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
    
    'セルの背景が黒だった場合、Lまで削除
    If Cells(i, 1).Interior.Color = RGB(0, 0, 0) Then
    
    Cells(i, 1).ClearContents
    Cells(i, 2).ClearContents
    Cells(i, 3).ClearContents
    Cells(i, 4).ClearContents
    Cells(i, 5).ClearContents
    Cells(i, 6).ClearContents
    Cells(i, 7).ClearContents
    Cells(i, 8).ClearContents
    Cells(i, 9).ClearContents
    Cells(i, 10).ClearContents
    Cells(i, 11).ClearContents
    Cells(i, 12).ClearContents
    
    End If
Next
        
End Sub
```
### （４）書式設定
```
Sub Macro4()
'書式調整
    
    '単価表_小見出し
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "材質"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "サイズ"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "4m単価"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "1mm単価"
    
    '途中計算_小見出し
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "寸法[mm]"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "小計[円]"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "材料費[円]"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "工費[円]"
    
    '列幅の調整
    Columns("H:S").Select
    Selection.Columns.AutoFit
    
    '灰色
    Columns("L").Select
    With Selection.Font
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
    End With
    
    Range("K1").Select
        
End Sub
```
### （５）合計欄の作成
```
Sub Macro5()
'合計欄の作成
    
    '最終行の取得
    Dim r As Long
    r = Cells(Rows.Count, 1).End(xlUp).Row
    
        'パーツ数
        Cells(r + 2, 8) = "パーツ数"
        '3→ｒまでデータ数カウント
        Cells(r + 3, 8) = WorksheetFunction.CountA(Range(Cells(3, 8), Cells(r, 8)))
        
        '小計
        Cells(r + 2, 9) = "小計"
        '3→ｒまで合計
        Cells(r + 3, 9) = WorksheetFunction.Sum(Range(Cells(3, 9), Cells(r, 9)))
        
        '材料費
        Cells(r + 2, 10) = "材料費"
        '3→ｒまで合計
        Cells(r + 3, 10) = WorksheetFunction.Sum(Range(Cells(3, 10), Cells(r, 10)))
        
        '工費
        Cells(r + 2, 11) = "工費"
        '3→ｒまで合計
        Cells(r + 3, 11) = WorksheetFunction.Sum(Range(Cells(3, 11), Cells(r, 11)))
        
        '中央ぞろえ
        Range(Cells(r + 2, 8), Cells(r + 3, 11)).Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        
        '金額形式
        Range(Cells(r + 3, 9), Cells(r + 3, 11)).Select
        Selection.NumberFormatLocal = "\#,##0_);[赤](\#,##0)"
        
        '黄色
        Range(Cells(r + 2, 8), Cells(r + 3, 8)).Select
        Selection.Interior.Color = 65535
      
End Sub
```
### （６）まとめて実行
```
Sub hitoheya()
'1部屋まとめて実行
    Call Macro1
    Call Macro2_1
    Call Macro2_2
    Call Macro2_3
    Call Macro2_4
    Call Macro3
    Call Macro4
    Call Macro5
End Sub
```
### 参考サイト
（２）
https://www.excel-ubara.com/excelvba1/EXCELVBA320.html
https://www.excel-ubara.com/excelvba1/EXCELVBA322.html
https://daitaideit.com/vba-if-usage/#mokuzi1-3
（３）
https://excel-ubara.com/excelvba1/EXCELVBA339.html
（４）
https://kosapi.com/post-1962/
（５）
https://lilia-study.com/excel/excel-vba/worksheetfunction/counta/
http://keiyu.xyz/2020/11/18/undersum/
https://webs-studio.jp/program/vba/5051/#index_id9
https://www.kotablo.com/entry/excel-vba-numberformatlocal-currency