LoginSignup
1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

@kero3

EXCEL備忘録

Last updated at Posted at 2021-02-09

自宅で使っているEXCEL 2013の個人向けのマクロを登録していく

0.基礎

0-1.関数

値を返すFunctionと値を返さないSubがある。

Sub Sample1()
    Dim buf As Long
    buf = 123
    MsgBox Func1(buf)
End Sub

Function Func1(arg As Long)
    Func1 = arg * 2
End Function

#1.WBS用条件付き書式作成

1-1.画面イメージ

image.png

1-2.マクロ

' 列番号→列名
Function ColumnIdx2Name(ByVal colNum As Long) As String
    ColumnIdx2Name = Split(Columns(colNum).Address, "$")(2)
End Function

' 列名→列番号
Function ColumnName2Idx(ByVal colName As String) As Long
    ColumnName2Idx = Columns(colName).Column
End Function

' 列番号の足し算
Function ColumnNameAdd(ByVal colName As String, ByVal addColumnNo As String) As String
    ColumnIdx = ColumnName2Idx(colName)
    ColumnNameAdd = ColumnIdx2Name(ColumnIdx + addColumnNo)
End Function


Sub WBSテスト()

    '===================================================================================
    ' EXCELでWBSを作成する際の条件付き書式作成マクロ
    '　・グループ行の背景色を塗る。(行)
    '　・土日の背景色を塗る。(列)
    '　・指定した日付の背景色を担当者毎に色を変えて塗りつぶす(セル)
    '
    '===================================================================================

    'データの位置指定(★の値を設定してください)
    
    '行の情報
    Day_Row = "3"       '★日付が指定されている行
    Start_Row = "4"     '★データの開始位置
    End_Row = "50"      '★データの終了位置

    '列の情報
    Group1 = "A"                                    '★大分類
    Group2 = ColumnNameAdd(Group1, 1)               '中分類 => 大分類の１つ横

    Start_Day_Col = "E"                             '★日付開始日
    End_Day_Col = ColumnNameAdd(Start_Day_Col, 1)   '日付終了日 => 開始日の１つ横
    Work_Day = ColumnNameAdd(Start_Day_Col, 2)      '作業日(終了日と開始日の差、土日を除く) => 開始日の２つ横
    
    Name_Col = ColumnNameAdd(Work_Day, 1)           '担当者 => 作業日の１つ横
    Work_Time = ColumnNameAdd(Name_Col, 1)          '作業工数 => 担当者の１つ横
    Start_Col = "J"     '★データの開始位置
    End_Col = "Z"       '★データの終了位置

    Const UserCount = 5 '★ユーザー情報
    Dim UserName(UserCount) As String
    UserName(1) = "AAA"
    UserName(2) = "BBB"
    UserName(3) = "CCC"
    UserName(4) = "DDD"
    UserName(5) = "EEE"
    
    '-----------------------------------------------------------------------------------
    '処理①行の塗りつぶし(グループ行)
    '-----------------------------------------------------------------------------------
    Rows(Start_Row + ":" + End_Row).Select
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND($" + Group1 + Start_Row + "<>"""")"

    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorDark1 ' 文字色を白
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 12611584   '背景色を青
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND($" + Group2 + Start_Row + "<>"""")"

    With Selection.FormatConditions(2).Font
        .ThemeColor = xlThemeColorDark1 ' 文字色を白
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(2).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5287936   '背景色を緑
        .TintAndShade = 0
    End With
    Selection.FormatConditions(2).StopIfTrue = False



    '-----------------------------------------------------------------------------------
    '処理② 土日の塗りつぶし(1:日曜、7:土曜)
    '-----------------------------------------------------------------------------------
    Range(Start_Col + Start_Row + ":" + End_Col + End_Row).Select
    week1 = "=WEEKDAY(" + Start_Col + "$" + Day_Row + ")=1"
    week2 = "=WEEKDAY(" + Start_Col + "$" + Day_Row + ")=7"

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:=week1

    With Selection.FormatConditions(3).Interior
        .ColorIndex = 45    '&H0099FF(オレンジ)
    End With
    Selection.FormatConditions(3).StopIfTrue = False

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:=week2

    With Selection.FormatConditions(4).Interior
        .ColorIndex = 23    '&HCC6600(青系)
    End With
    Selection.FormatConditions(4).StopIfTrue = False

    '-----------------------------------------------------------------------------------
    '処理③担当者の塗りつぶし
    '-----------------------------------------------------------------------------------

    Dim UserNameParam(UserCount) As String
    For i = 1 To UserCount
        UserNameParam(i) = "=AND($" + Name_Col + Start_Row + "=""" & UserName(i) & """" + _
        ",$" + Start_Day_Col + Start_Row + "<=" + Start_Col + "$" + Day_Row + ",$" _
        + End_Day_Col + Start_Row + ">=" + Start_Col + "$" + Day_Row + ")"
    Next i


    Selection.FormatConditions.Add Type:=xlExpression, Formula1:=UserNameParam(1)
    With Selection.FormatConditions(5).Interior
        .ColorIndex = 34    '&HFFFFCC(薄い水色)
    End With

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:=UserNameParam(2)

    With Selection.FormatConditions(6).Interior
        .ColorIndex = 35    'HCCFFCC(薄い緑色)
    End With

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:=UserNameParam(3)

    With Selection.FormatConditions(7).Interior
        .ColorIndex = 36    'H99FFFF(薄い黄色)
    End With

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:=UserNameParam(4)
    With Selection.FormatConditions(8).Interior
        .ColorIndex = 39    'HFF99CC(薄い紫色)
    End With

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:=UserNameParam(5)
    With Selection.FormatConditions(9).Interior
        .ColorIndex = 40
    End With
    

    'グループ化を行う前に全解除
    ActiveSheet.Cells.ClearOutline

    Dim row As Long '処理行を格納する
    Dim tmp_group_end As Long '大グループの終了行

    For row = Start_Row To End_Row
    
        '稼働日の計算は大分類、中分類、明細、すべてに対して実施する
        Cells(row, Work_Day).Value = "=NETWORKDAYS(" & Start_Day_Col & row & "," & End_Day_Col & row & ")"
            
        '大分類の処理を行う
        If Cells(row, Group1) <> "" Then
            tmp_group_end = Cells(row, Group1).End(xlDown).row - 1

            '一番最後の行は行わない
            If tmp_group_end < Val(End_Row) Then

                ' 工数の合計
                Cells(row, Work_Time).Value = "=SUMIF(" & Range(Cells(row + 1, Group2), Cells(tmp_group_end, Group2)).Address(False, False) & ", " & Chr(34) & "<>" & Chr(34) & "," & Range(Cells(row + 1, Work_Time), Cells(tmp_group_end, Work_Time)).Address(False, False) & ")"

                '開始日の最小
                Cells(row, Start_Day_Col).Value = "=MIN(" & Range(Cells(row + 1, Start_Day_Col), Cells(tmp_group_end, Start_Day_Col)).Address(False, False) & ")"

                '終了日の最大
                Cells(row, End_Day_Col).Value = "=MAX(" & Range(Cells(row + 1, End_Day_Col), Cells(tmp_group_end, End_Day_Col)).Address(False, False) & ")"

                '開始日と終了日の日付フォーマット
                Cells(row, Start_Day_Col).NumberFormatLocal = "m""月""d""日"";@"
                Cells(row, End_Day_Col).NumberFormatLocal = "m""月""d""日"";@"

                'グループ化
                Range(Cells(row + 1, Group1), Cells(tmp_group_end, Group1)).Rows.Group

            End If

        End If

        '中分類の処理を行う
        If Cells(row, Group2) <> "" And Cells(row, Group1) = "" Then
            ' 工数の合計
            If Cells(row + 2, Work_Time) <> "" Then
                Cells(row, Work_Time).Value = "=SUM(" & Range(Cells(row + 1, Work_Time), Cells(row + 1, Work_Time).End(xlDown)).Address(False, False) & ")"
            Else
                Cells(row, Work_Time).Value = "=SUM(" & Range(Cells(row + 1, Work_Time), Cells(row + 1, Work_Time)).Address(False, False) & ")"
            End If

            '開始日の最小
            If Cells(row + 2, Work_Time) <> "" Then
                Cells(row, Start_Day_Col).Value = "=MIN(" & Range(Cells(row + 1, Start_Day_Col), Cells(row + 1, Start_Day_Col).End(xlDown)).Address(False, False) & ")"
            Else
                Cells(row, Start_Day_Col).Value = "=MIN(" & Range(Cells(row + 1, Start_Day_Col), Cells(row + 1, Start_Day_Col)).Address(False, False) & ")"
            End If

            '終了日の最大
            If Cells(row + 2, Work_Time) <> "" Then
                Cells(row, End_Day_Col).Value = "=MAX(" & Range(Cells(row + 1, End_Day_Col), Cells(row + 1, End_Day_Col).End(xlDown)).Address(False, False) & ")"
            Else
                Cells(row, End_Day_Col).Value = "=MAX(" & Range(Cells(row + 1, End_Day_Col), Cells(row + 1, End_Day_Col)).Address(False, False) & ")"
            End If

            '開始日と終了日の日付フォーマット
            Cells(row, Start_Day_Col).NumberFormatLocal = "m""月""d""日"";@"
            Cells(row, End_Day_Col).NumberFormatLocal = "m""月""d""日"";@"

            'グループ化
            If Cells(row + 2, Work_Time) <> "" Then
                Range(Cells(row + 1, Work_Time), Cells(row + 1, Work_Time).End(xlDown)).Rows.Group
            Else
                Range(Cells(row + 1, Work_Time), Cells(row + 1, Work_Time)).Rows.Group
            End If

        End If
    Next

    MsgBox "処理終了"


End Sub

#2.WBS用要員展開

2-1.画面イメージ

変更前
image.png

2-2.マクロ

Sub 要員展開()
    '===================================================================================
    ' EXCELでWBSを作成した後の要因展開資料作成用マクロ
    ' WBSの特定の列を別シートで張り付ける
    '
    '===================================================================================

    'データの位置指定
    '行の情報
    Day_Row = "9"       '日付が指定されている行
    Start_Row = "10"     'データの開始位置
    End_row = "50"      'データの終了位置


    Start_Day_Col = "B"                             '★日付開始日
    End_Day_Col = ColumnNameAdd(Start_Day_Col, 1)   '日付終了日 => 開始日の１つ横
    Work_Day = ColumnNameAdd(Start_Day_Col, 2)      '作業日(終了日と開始日の差、土日を除く) => 開始日の２つ横

    Name_Col = ColumnNameAdd(Work_Day, 1)           '担当者 => 作業日の１つ横
    Work_Time = ColumnNameAdd(Name_Col, 1)          '作業工数 => 担当者の１つ横
    Start_Col = "G"     '★データの開始位置
    End_Col = "Z"       '★データの終了位置

    Const UserCount = 5 '★ユーザー情報
    Dim UserName(UserCount) As String
    UserName(1) = "AAA"
    UserName(2) = "BBB"
    UserName(3) = "CCC"
    UserName(4) = "DDD"
    UserName(5) = "EEE"
    
        Dim row As Long '処理行を格納する
     'データの集計
     For row = 1 To UserCount
        Cells(row, Name_Col).Value = UserName(row)
     Next
     
    Cells(UserCount + 1, Name_Col).Value = "合計"

    '日単位の担当者の作業工数
     For row = 1 To UserCount
        Cells(row, Start_Col).Value = "=SUMIF($" & Name_Col & "$" & Start_Row & ":$" & Name_Col & "$" & End_row & ",$" & Name_Col & row & "," & Start_Col & "$" & Start_Row & ":" & Start_Col & "$" & End_row & ")"
         Cells(row, Start_Col).NumberFormatLocal = "0.0_ "
    Next
    Cells(UserCount + 1, Start_Col).Value = "=SUM(" & Start_Col & (1) & ":" & Start_Col & (UserCount) & ")"
    Cells(UserCount + 1, Start_Col).NumberFormatLocal = "0.0_ "
    
    ' 担当者毎の合計工数
     For row = 1 To (UserCount + 1)
        Cells(row, ColumnNameAdd(Name_Col, 1)).Value = "=SUM(" & Start_Col & (row) & ":" & End_Col & (row) & ")"
     Next

    Dim Start_Day As Date
    Start_Day = "2/10"


    For row = Start_Row To End_row

        Cells(row, Start_Day_Col).NumberFormatLocal = "m""月""d""日"";@"
        Cells(row, End_Day_Col).NumberFormatLocal = "m""月""d""日"";@"

    Next


    '日付を作成
    tmp_day = Start_Day
    Dim col As Long '処理列を格納する
    For col = ColumnName2Idx(Start_Col) To ColumnName2Idx(End_Col)   'アルファベットの列名だと数値で判断ができないため数値に変換
        tmp_day = tmp_day + 1
        If Weekday(tmp_day) = 7 Then
            tmp_day = tmp_day + 2   '土曜日の場合は2日足して月曜日にする
        End If

        Cells(Day_Row, col).Value = tmp_day
        Cells(Day_Row, col).NumberFormatLocal = "d"""";@"   '日付は列幅を短くするため日のみ表示する

    Next

    Dim Data_WorkTime As Double     '登録された工数を格納
    Dim Data_day1_Time As Double    '日単位の時間を計算し格納
    '作業日のセット、行ループの中で列ループを行う
    For row = Start_Row To End_row
        If Cells(row, ColumnName2Idx(Name_Col)).Value <> "" Then
            '登録されている工数をセット
            Data_WorkTime = Val(Cells(row, Work_Time).Value)
    
            If Data_WorkTime > 0 Then
    
                '1日当たりの作業時間を計算
                Data_day1_Time = Data_WorkTime / Cells(row, Work_Day).Value
    
                '作業日を検索し、セット
                For col = ColumnName2Idx(Start_Col) To ColumnName2Idx(End_Col)   'アルファベットの列名だと数値で判断ができないため数値に変換
                    If Cells(Day_Row, col).Value >= Cells(row, Start_Day_Col).Value And Cells(Day_Row, col).Value <= Cells(row, End_Day_Col).Value Then
                        Cells(row, col).Value = Str(Data_day1_Time)
                        Cells(row, col).NumberFormatLocal = "0.0_ "
                    End If
    
                Next
            End If
        End If
     Next


    MsgBox "処理終了"
End Sub

3.作業中

3-1.機能追加と関数化中

' ====================================================================================================================
' 共通関数エリア
' ====================================================================================================================
' 列番号→列名
Function ColumnIdx2Name(ByVal colNum As Long) As String
    ColumnIdx2Name = Split(Columns(colNum).Address, "$")(2)
End Function

' 列名→列番号
Function ColumnName2Idx(ByVal colName As String) As Long
    ColumnName2Idx = Columns(colName).Column
End Function

' 列番号の足し算
Function ColumnNameAdd(ByVal colName As String, ByVal addColumnNo As String) As String
    ColumnIdx = ColumnName2Idx(colName)
    ColumnNameAdd = ColumnIdx2Name(ColumnIdx + addColumnNo)
End Function

' ====================================================================================================================
' フォーマット設定エリア　★必要に応じて修正する
' ====================================================================================================================
Function 開始行()
    開始行 = "4"        '★修正
End Function

Function 終了行()
    終了行 = "50"       '★修正
End Function

Function 開始列()
    開始列 = "M"        '★修正
End Function

Function 終了列()
    終了列 = "AZ"       '★修正
End Function

Function 大グループ()
     大グループ = "B"
End Function

Function 中グループ()
    中グループ = ColumnNameAdd(大グループ, 1)
End Function

Function 日付表示行()
    日付表示行 = "3"
End Function

Function 開始日()
    開始日 = "F"
End Function

Function 終了日()
    終了日 = ColumnNameAdd(開始日(), 1)
End Function

Function 作業日数()
    作業日数 = ColumnNameAdd(終了日(), 1)
End Function

Function 担当者()
    担当者 = ColumnNameAdd(作業日数(), 1)
End Function

Function 予定工数()
    予定工数 = ColumnNameAdd(担当者(), 1)
End Function

Function 実績工数()
    実績工数 = ColumnNameAdd(予定工数(), 1)
End Function

Function 状況()
    状況 = ColumnNameAdd(実績工数(), 1)
End Function

' ====================================================================================================================
' サブ関数エリア
' ====================================================================================================================
Sub グループ行の塗りつぶし()
    Rows(開始行() + ":" + 終了行()).Select
        Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:= _
        "=AND($" + 大グループ() + 開始行() + "<>"""")")

    With fc.Font
        .ThemeColor = xlThemeColorDark1 ' 文字色を白
        .TintAndShade = 0
    End With
    With fc.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 12611584   '背景色を青
        .TintAndShade = 0
    End With
    fc.StopIfTrue = False

        Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:= _
        "=AND($" + 中グループ() + 開始行() + "<>"""")")

    With fc.Font
        .ThemeColor = xlThemeColorDark1 ' 文字色を白
        .TintAndShade = 0
    End With
    With fc.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5287936   '背景色を緑
        .TintAndShade = 0
    End With
    fc.StopIfTrue = False
End Sub

Sub 土日の塗りつぶし()
    Range(開始列() + 日付表示行() + ":" + 終了列() + 終了行()).Select
    week1 = "=WEEKDAY(" + 開始列() + "$" + 日付表示行() + ")=1"
    week2 = "=WEEKDAY(" + 開始列() + "$" + 日付表示行() + ")=7"

    Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=week1)

    With fc.Interior
        .ColorIndex = 45    '&H0099FF(オレンジ)
    End With
    fc.StopIfTrue = False

    Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=week2)

    With fc.Interior
        .ColorIndex = 23    '&HCC6600(青系)
    End With
    fc.StopIfTrue = False
End Sub

Sub 稼働日計算(ByVal row As Long)
    If Cells(row, 開始日()) <> "" Then
        Cells(row, 作業日数()).Value = "=NETWORKDAYS(" & 開始日() & row & "," & 終了日() & row & ")"
        Cells(row, 作業日数()).NumberFormatLocal = "0_);[赤](0)"
    End If
End Sub

Sub 実績工数計算(ByVal row As Long)
    If Cells(row, 担当者()) <> "" Then
        Cells(row, 実績工数()).Value = "=SUM(" & 開始列() & row & ":" & 終了列() & row & ")"
        Cells(row, 実績工数()).NumberFormatLocal = "0_);[赤](0)"
    End If
End Sub

Sub 日付フォーマット(ByVal row As Long)
    Cells(row, 開始日()).NumberFormatLocal = "m""月""d""日"";@"
    Cells(row, 終了日()).NumberFormatLocal = "m""月""d""日"";@"
End Sub

Sub 担当者の塗りつぶし()

    Const UserCount = 5 '★ユーザー情報
    Dim UserName(UserCount) As String
    UserName(1) = "AAA"
    UserName(2) = "BBB"
    UserName(3) = "CCC"
    UserName(4) = "DDD"
    UserName(5) = "EEE"
    
    Dim UserNameParam(UserCount) As String
    For i = 1 To UserCount
        UserNameParam(i) = "=AND($" + 担当者() + 開始行() + "=""" & UserName(i) & """" + _
        ",$" + 開始日() + 開始行() + "<=" + 開始列() + "$" + 日付表示行() + ",$" _
        + 終了日() + 開始行() + ">=" + 開始列() + "$" + 日付表示行() + ")"
    Next i
    
    Range(開始列() + 開始行() + ":" + 終了列() + 終了行()).Select

    Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=UserNameParam(1))
    With fc.Interior
        .ColorIndex = 34    '&HFFFFCC(薄い水色)
    End With
    
    Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=UserNameParam(2))

    With fc.Interior
        .ColorIndex = 35    'HCCFFCC(薄い緑色)
    End With

    Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=UserNameParam(3))

    With fc.Interior
        .ColorIndex = 36    'H99FFFF(薄い黄色)
    End With

    Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=UserNameParam(4))
    With fc.Interior
        .ColorIndex = 39    'HFF99CC(薄い紫色)
    End With
    Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=UserNameParam(5))
    With fc.Interior
        .ColorIndex = 40
    End With
    
End Sub

Sub 状況の塗りつぶし()
    Rows(開始行() + ":" + 終了行()).Select
        Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:= _
        "=AND($" + 状況() + 開始行() + "=2)")

    With fc.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With
    fc.StopIfTrue = False

        Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:= _
        "=AND($" + 状況() + 開始行() + "=1)")

    With fc.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    fc.StopIfTrue = False
End Sub

Sub 本日の塗りつぶし()
    Range(開始列() + 日付表示行() + ":" + 終了列() + 終了行()).Select
    today = "=" + 開始列() + "$" + 日付表示行() + "=TODAY()"


    Set fc = Selection.FormatConditions.Add(Type:=xlExpression, Formula1:=today)

    With fc.Interior
        .ColorIndex = 6
    End With
    fc.StopIfTrue = False

End Sub

Sub WBSテスト()

    '===================================================================================
    ' EXCELでWBSを作成する際の条件付き書式作成マクロ
    '　・グループ行の背景色を塗る。(行)
    '　・土日の背景色を塗る。(列)
    '　・指定した日付の背景色を担当者毎に色を変えて塗りつぶす(セル)
    '
    '===================================================================================



    '列の情報
    Group1 = 大グループ()                                    '★大分類
    Group2 = 中グループ()               '中分類 => 大分類の１つ横

    Start_Day_Col = 開始日()                             '★日付開始日
    End_Day_Col = 終了日()   '日付終了日 => 開始日の１つ横

    Work_Time = 予定工数()          '作業工数 => 担当者の１つ横
    Start_Col = 開始列()     '★データの開始位置
    End_Col = 終了列()       '★データの終了位置

    本日の塗りつぶし
    土日の塗りつぶし
    グループ行の塗りつぶし
    担当者の塗りつぶし
    状況の塗りつぶし

    
    'グループ化を行う前に全解除
    ActiveSheet.Cells.ClearOutline

    Dim row As Long '処理行を格納する
    Dim tmp_group1_end As Long '大グループの終了行
    Dim tmp_group2_end As Long '中グループの終了行
    
    For row = 開始行() To 終了行()

        '稼働日の計算は大分類、中分類、明細、すべてに対して実施する
        稼働日計算 (row)
        実績工数計算 (row)
        日付フォーマット (row)

        '大分類の処理を行う
        If Cells(row, Group1) <> "" Then
            tmp_group1_end = Cells(row, Group1).End(xlDown).row - 1

            '一番最後の行は行わない
            If tmp_group1_end < Val(終了行()) Then

                ' 工数の合計
                Cells(row, Work_Time).Value = "=SUMIF(" & Range(Cells(row + 1, Group2), Cells(tmp_group1_end, Group2)).Address(False, False) & ", " & Chr(34) & "<>" & Chr(34) & "," & Range(Cells(row + 1, Work_Time), Cells(tmp_group1_end, Work_Time)).Address(False, False) & ")"
                Cells(row, 実績工数()).Value = "=SUMIF(" & Range(Cells(row + 1, Group2), Cells(tmp_group1_end, Group2)).Address(False, False) & ", " & Chr(34) & "<>" & Chr(34) & "," & Range(Cells(row + 1, 実績工数()), Cells(tmp_group1_end, 実績工数())).Address(False, False) & ")"

                '開始日の最小
                Cells(row, Start_Day_Col).Value = "=MIN(" & Range(Cells(row + 1, Start_Day_Col), Cells(tmp_group1_end, Start_Day_Col)).Address(False, False) & ")"

                '終了日の最大
                Cells(row, End_Day_Col).Value = "=MAX(" & Range(Cells(row + 1, End_Day_Col), Cells(tmp_group1_end, End_Day_Col)).Address(False, False) & ")"
                
                'グループ化
                Range(Cells(row + 1, Group1), Cells(tmp_group1_end, Group1)).Rows.Group

            End If

        End If

        '中分類の処理を行う
        If Cells(row, Group2) <> "" And Cells(row, Group1) = "" Then
            tmp_group2_end = Cells(row, Group2).End(xlDown).row - 1
            If tmp_group2_end > tmp_group1_end Then
                tmp_group2_end = tmp_group1_end - 1
            End If
            
            ' 工数の合計
            Cells(row, Work_Time).Value = "=SUM(" & Range(Cells(row + 1, Work_Time), Cells(tmp_group2_end, Work_Time)).Address(False, False) & ")"
            Cells(row, 実績工数()).Value = "=SUM(" & Range(Cells(row + 1, 実績工数()), Cells(tmp_group2_end, 実績工数())).Address(False, False) & ")"


            '開始日の最小
            Cells(row, Start_Day_Col).Value = "=MIN(" & Range(Cells(row + 1, Start_Day_Col), Cells(tmp_group2_end, Start_Day_Col)).Address(False, False) & ")"


            '終了日の最大
            Cells(row, End_Day_Col).Value = "=MAX(" & Range(Cells(row + 1, End_Day_Col), Cells(tmp_group2_end, End_Day_Col)).Address(False, False) & ")"

                
            'グループ化
            Range(Cells(row + 1, Work_Time), Cells(tmp_group2_end, Work_Time)).Rows.Group


        End If
    Next

    MsgBox "処理終了"


End Sub

#9.TIPS

9-1.名前を付けた表をコンボで表示

ポイントはテーブルとINDIRECT。
image.png

EXCELの「挿入」リボンに「テーブル」がある。
https://support.microsoft.com/ja-jp/office/excel-%E3%81%AE%E5%90%8D%E5%89%8D%E3%83%9E%E3%83%8D%E3%83%BC%E3%82%B8%E3%83%A3%E3%83%BC%E3%82%92%E4%BD%BF%E7%94%A8%E3%81%99%E3%82%8B-4d8c4c2b-9f7d-44e3-a3b4-9f61bd5c64e4
https://support.microsoft.com/ja-jp/office/excel-%E3%83%86%E3%83%BC%E3%83%96%E3%83%AB%E3%81%A7%E3%81%AE%E6%A7%8B%E9%80%A0%E5%8C%96%E5%8F%82%E7%85%A7%E3%81%AE%E4%BD%BF%E3%81%84%E6%96%B9-f5ed2452-2337-4f71-bed3-c8ae6d2b276e
これを使用して複数列を持つ表の指定列だけをコンボにすることができる。

1
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?