シート
データベース構造の解析_フィールドの情報
データベース構造の解析_フィールドの情報
Sub シート_データベース構造の解析_フィールドの情報()
'データベース構造の解析のフィールドの情報を編集する。 Dim s As Worksheet Dim r_end As Integer Dim i As Integer Dim i1 As Integer Dim w_int As Integer Dim w_テーブル As String Set s = ActiveSheet With s.UsedRange r_end = .Row + .Rows.Count - 1 End With
For i = 1 To r_end w_int = InStr(1, s.Cells(i, 1), "テーブル: ") If w_int > 0 Then w_テーブル = Trim(MidB(s.Cells(i, 1).Value, 11, 40)) End If If Trim(Left(s.Cells(i, 1).Value, 11)) = "" And Trim(Mid(s.Cells(i, 1).Value, 12, 1)) <> "" Then If Mid(s.Cells(i, 1).Value, 12, 6) <> "フィールド名" Then s.Cells(i, 1).Interior.ColorIndex = 6 s.Cells(i, 2).Value = w_テーブル s.Cells(i, 5).Value = Trim(Mid(s.Cells(i, 1).Value, 12, 20)) s.Cells(i, 8).Value = Trim(Mid(s.Cells(i, 1).Value, 78, 20)) s.Cells(i, 9).Value = Trim(Right(s.Cells(i, 1).Value, 10)) i1 = i End If End If w_int = InStr(1, s.Cells(i, 1), "Caption:") If w_int > 0 Then s.Cells(i1, 3).Value = Trim(Mid(s.Cells(i, 1).Value, 56, 20)) End If w_int = InStr(1, s.Cells(i, 1), "Required:") If w_int > 0 Then If Trim(Mid(s.Cells(i, 1).Value, 56, 20)) = "True" Then s.Cells(i1, 7).Value = "P" End If s.Cells(i1, 10).Value = Trim(Mid(s.Cells(i, 1).Value, 56, 20)) End If w_int = InStr(1, s.Cells(i, 1), "Description:") If w_int > 0 Then s.Cells(i1, 11).Value = Trim(Mid(s.Cells(i, 1).Value, 56, 99)) End If Next i
For i = 1 To r_end
If s.Cells(i, 1).Interior.ColorIndex = 6 Then If s.Cells(i, 3).Value = "" Then s.Cells(i, 3).Value = "'－" End If End If Next i s.Columns("B:K").ColumnWidth = 2 s.Columns("B:K").EntireColumn.AutoFit
End Sub
'データベース構造の解析のフィールドの情報を編集する。 Dim s As Worksheet Dim r_end As Integer Dim i As Integer Dim i1 As Integer Dim w_int As Integer Dim w_テーブル As String Set s = ActiveSheet With s.UsedRange r_end = .Row + .Rows.Count - 1 End With
For i = 1 To r_end w_int = InStr(1, s.Cells(i, 1), "テーブル: ") If w_int > 0 Then w_テーブル = Trim(MidB(s.Cells(i, 1).Value, 11, 40)) End If If Trim(Left(s.Cells(i, 1).Value, 11)) = "" And Trim(Mid(s.Cells(i, 1).Value, 12, 1)) <> "" Then If Mid(s.Cells(i, 1).Value, 12, 6) <> "フィールド名" Then s.Cells(i, 1).Interior.ColorIndex = 6 s.Cells(i, 2).Value = w_テーブル s.Cells(i, 5).Value = Trim(Mid(s.Cells(i, 1).Value, 12, 20)) s.Cells(i, 8).Value = Trim(Mid(s.Cells(i, 1).Value, 78, 20)) s.Cells(i, 9).Value = Trim(Right(s.Cells(i, 1).Value, 10)) i1 = i End If End If w_int = InStr(1, s.Cells(i, 1), "Caption:") If w_int > 0 Then s.Cells(i1, 3).Value = Trim(Mid(s.Cells(i, 1).Value, 56, 20)) End If w_int = InStr(1, s.Cells(i, 1), "Required:") If w_int > 0 Then If Trim(Mid(s.Cells(i, 1).Value, 56, 20)) = "True" Then s.Cells(i1, 7).Value = "P" End If s.Cells(i1, 10).Value = Trim(Mid(s.Cells(i, 1).Value, 56, 20)) End If w_int = InStr(1, s.Cells(i, 1), "Description:") If w_int > 0 Then s.Cells(i1, 11).Value = Trim(Mid(s.Cells(i, 1).Value, 56, 99)) End If Next i
For i = 1 To r_end
If s.Cells(i, 1).Interior.ColorIndex = 6 Then If s.Cells(i, 3).Value = "" Then s.Cells(i, 3).Value = "'－" End If End If Next i s.Columns("B:K").ColumnWidth = 2 s.Columns("B:K").EntireColumn.AutoFit
End Sub
データベース構造の解析
データベース構造の解析
Sub シート_データベース構造の解析()
'データベース構造の解析を編集する。 Dim s As Worksheet Dim r_end As Integer Dim i As Integer Dim i1 As Integer Dim w_int As Integer Dim w_int1 As Integer Dim w_int2 As Integer Dim w_str As String Set s = ActiveSheet With s.UsedRange r_end = .Row + .Rows.Count - 1 End With
With Columns("A:A").Font .name = "ＭＳ ゴシック" End With For i = 1 To r_end w_int = InStr(1, s.Cells(i, 1).Value, "テーブル:") If w_int > 0 Then s.Cells(i, 1).Interior.ColorIndex = 6 s.Cells(i, 3).Value = Trim(Mid(s.Cells(i, 1).Value, w_int + 6, 30)) i1 = i End If w_int = InStr(1, s.Cells(i, 1).Value, "Description:") If w_int > 0 Then s.Cells(i1, 2).Value = Trim(Mid(s.Cells(i, 1).Value, w_int + 32, 30)) End If w_int = InStr(1, s.Cells(i, 1).Value, "LastUpdated:") If w_int > 0 Then s.Cells(i1, 4).Value = Trim(Mid(s.Cells(i, 1).Value, w_int + 32, 30)) End If If i = 55 Then Stop w_int = InStr(1, s.Cells(i, 1).Value, ";DATABASE=") If w_int > 0 Then w_int = w_int + 10 w_int1 = InStr(w_int, s.Cells(i, 1).Value, " ") If w_int1 = 0 Then w_int1 = Len(s.Cells(i, 1).Value) End If w_str = Trim(s.Cells(i + 1, 1).Value) w_int2 = InStr(1, w_str, " ") If w_int2 = 0 Then w_int2 = Len(w_str) Else w_int2 = w_int2 - 1 End If w_str = Left(w_str, w_int2) s.Cells(i1, 5).Value = Trim(Mid(s.Cells(i, 1).Value, w_int, w_int1 - w_int)) & w_str End If Next i
For i = 1 To r_end If s.Cells(i, 1).Interior.ColorIndex = 6 Then If s.Cells(i, 2).Value = "" Then s.Cells(i, 2).Value = "'－" End If End If Next i s.Columns("B:E").EntireColumn.AutoFit
End Sub
'データベース構造の解析を編集する。 Dim s As Worksheet Dim r_end As Integer Dim i As Integer Dim i1 As Integer Dim w_int As Integer Dim w_int1 As Integer Dim w_int2 As Integer Dim w_str As String Set s = ActiveSheet With s.UsedRange r_end = .Row + .Rows.Count - 1 End With
With Columns("A:A").Font .name = "ＭＳ ゴシック" End With For i = 1 To r_end w_int = InStr(1, s.Cells(i, 1).Value, "テーブル:") If w_int > 0 Then s.Cells(i, 1).Interior.ColorIndex = 6 s.Cells(i, 3).Value = Trim(Mid(s.Cells(i, 1).Value, w_int + 6, 30)) i1 = i End If w_int = InStr(1, s.Cells(i, 1).Value, "Description:") If w_int > 0 Then s.Cells(i1, 2).Value = Trim(Mid(s.Cells(i, 1).Value, w_int + 32, 30)) End If w_int = InStr(1, s.Cells(i, 1).Value, "LastUpdated:") If w_int > 0 Then s.Cells(i1, 4).Value = Trim(Mid(s.Cells(i, 1).Value, w_int + 32, 30)) End If If i = 55 Then Stop w_int = InStr(1, s.Cells(i, 1).Value, ";DATABASE=") If w_int > 0 Then w_int = w_int + 10 w_int1 = InStr(w_int, s.Cells(i, 1).Value, " ") If w_int1 = 0 Then w_int1 = Len(s.Cells(i, 1).Value) End If w_str = Trim(s.Cells(i + 1, 1).Value) w_int2 = InStr(1, w_str, " ") If w_int2 = 0 Then w_int2 = Len(w_str) Else w_int2 = w_int2 - 1 End If w_str = Left(w_str, w_int2) s.Cells(i1, 5).Value = Trim(Mid(s.Cells(i, 1).Value, w_int, w_int1 - w_int)) & w_str End If Next i
For i = 1 To r_end If s.Cells(i, 1).Interior.ColorIndex = 6 Then If s.Cells(i, 2).Value = "" Then s.Cells(i, 2).Value = "'－" End If End If Next i s.Columns("B:E").EntireColumn.AutoFit
End Sub
ナレッジ用作成
ナレッジ用作成
Sub シート_ナレッジ用作成()
Dim w_ActiveCell As Range Dim w_range As Range
Set w_ActiveCell = ActiveCell
Cells.ColumnWidth = 2 Cells.NumberFormatLocal = "G/標準" Cells.Font.name = "HGｺﾞｼｯｸM" Columns("A:A").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlTop .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.NumberFormatLocal = "@" Range("A1").HorizontalAlignment = xlGeneral Columns("B:B").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlTop .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With Selection.NumberFormatLocal = "@" Range("B1").Select Selection.ColumnWidth = 100 Columns("C:C").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlTop .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With Selection.NumberFormatLocal = "@" Range("C1").Select Selection.ColumnWidth = 100 Rows("1:1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 12611584 '青 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection.Font .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 End With
ActiveWindow.FreezePanes = False Range("3:3").Activate ActiveWindow.FreezePanes = True
Cells.VerticalAlignment = xlTop If Range("A1") = "" Or Range("A1") = "INDEX" Or Range("A1") = "※" Then Range("A1").Select ActiveCell.FormulaR1C1 = "※" ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="INDEX!A1", TextToDisplay:="※" With Selection.Font .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 End With End If Range("A1").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(1, 1), TrailingMinusNumbers:=True If ActiveSheet.AutoFilterMode Then Selection.AutoFilter End If If Range("A2").Value = "(LINK)" Then Range("A2").Value = "" End If ActiveSheet.Cells.Select On Error Resume Next Selection.AutoFilter On Error GoTo 0 Columns(1).AutoFit Selection.AutoFilter w_ActiveCell.Select Application.StatusBar = False
End Sub
Dim w_ActiveCell As Range Dim w_range As Range
Set w_ActiveCell = ActiveCell
Cells.ColumnWidth = 2 Cells.NumberFormatLocal = "G/標準" Cells.Font.name = "HGｺﾞｼｯｸM" Columns("A:A").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlTop .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.NumberFormatLocal = "@" Range("A1").HorizontalAlignment = xlGeneral Columns("B:B").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlTop .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With Selection.NumberFormatLocal = "@" Range("B1").Select Selection.ColumnWidth = 100 Columns("C:C").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlTop .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With Selection.NumberFormatLocal = "@" Range("C1").Select Selection.ColumnWidth = 100 Rows("1:1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 12611584 '青 .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection.Font .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 End With
ActiveWindow.FreezePanes = False Range("3:3").Activate ActiveWindow.FreezePanes = True
Cells.VerticalAlignment = xlTop If Range("A1") = "" Or Range("A1") = "INDEX" Or Range("A1") = "※" Then Range("A1").Select ActiveCell.FormulaR1C1 = "※" ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="INDEX!A1", TextToDisplay:="※" With Selection.Font .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 End With End If Range("A1").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(1, 1), TrailingMinusNumbers:=True If ActiveSheet.AutoFilterMode Then Selection.AutoFilter End If If Range("A2").Value = "(LINK)" Then Range("A2").Value = "" End If ActiveSheet.Cells.Select On Error Resume Next Selection.AutoFilter On Error GoTo 0 Columns(1).AutoFit Selection.AutoFilter w_ActiveCell.Select Application.StatusBar = False
End Sub
ページ設定
ページ設定
Sub シート_ページ設定() With ActiveSheet.PageSetup .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = 1 End With
End Sub
End Sub
区切り位置なし
区切り位置なし
Sub シート_区切り位置なし()
'区切り位置無しに設定
Dim w_range As Range Set w_range = ActiveCell
If Range("A1") = "" Then Range("A1") = "xxx" End If Range("A1").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _ Other:=False, FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True
If Range("A1") = "xxx" Then Range("A1") = "" End If
w_range.Activate
End Sub
'区切り位置無しに設定
Dim w_range As Range Set w_range = ActiveCell
If Range("A1") = "" Then Range("A1") = "xxx" End If Range("A1").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _ Other:=False, FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True
If Range("A1") = "xxx" Then Range("A1") = "" End If
w_range.Activate
End Sub
テーブル化
テーブル化
Sub シート_テーブル化()
Dim w_range As Range Dim w_str As String On Error Resume Next ActiveSheet.ListObjects(1).Unlist On Error GoTo 0 If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then ActiveSheet.UsedRange.Select Cells.ColumnWidth = 2 ElseIf Selection.Rows.Count > ActiveSheet.UsedRange.Rows.Count Or Selection.Columns.Count > ActiveSheet.UsedRange.Columns.Count Then ActiveSheet.UsedRange.Select Cells.ColumnWidth = 2 End If If Selection(1).Value = "" Then Selection(1).Value = "AAA" End If With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection.Font .Size = 12 End With Selection.Font.Bold = False With Selection.Font .Size = 12 End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone w_str = "t_" & ActiveSheet.name ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).name = w_str ActiveSheet.ListObjects(w_str).TableStyle = "TableStyleMedium13"
Range(w_str).Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlTop .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Rows("1:1") .HorizontalAlignment = xlLeft .VerticalAlignment = xlTop .WrapText = False If ActiveSheet.ListObjects(w_str).ListColumns.Count > 20 Then .Orientation = xlVertical End If .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With
Range(w_str & "[#All]").Select Selection.ColumnWidth = 50 Selection.Columns.AutoFit Selection.Rows.AutoFit For Each w_range In ActiveSheet.ListObjects(w_str).HeaderRowRange Select Case w_range.Value Case "日付", "作成日", "更新日" w_range.EntireColumn.NumberFormatLocal = "yyyy-mm-dd;@" w_range.EntireColumn.AutoFit ActiveSheet.DisplayPageBreaks = False End Select Next w_range On Error GoTo l_wnd Range("t_時間集計[#Headers]").Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlTop .WrapText = False .Orientation = xlVertical .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("t_時間集計[#All]").Select Selection.Columns.AutoFit l_end: Rows("2:2").Select ActiveWindow.FreezePanes = True Range("A1").Select
End Sub
Dim w_range As Range Dim w_str As String On Error Resume Next ActiveSheet.ListObjects(1).Unlist On Error GoTo 0 If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then ActiveSheet.UsedRange.Select Cells.ColumnWidth = 2 ElseIf Selection.Rows.Count > ActiveSheet.UsedRange.Rows.Count Or Selection.Columns.Count > ActiveSheet.UsedRange.Columns.Count Then ActiveSheet.UsedRange.Select Cells.ColumnWidth = 2 End If If Selection(1).Value = "" Then Selection(1).Value = "AAA" End If With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With With Selection.Font .Size = 12 End With Selection.Font.Bold = False With Selection.Font .Size = 12 End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone w_str = "t_" & ActiveSheet.name ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).name = w_str ActiveSheet.ListObjects(w_str).TableStyle = "TableStyleMedium13"
Range(w_str).Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlTop .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Rows("1:1") .HorizontalAlignment = xlLeft .VerticalAlignment = xlTop .WrapText = False If ActiveSheet.ListObjects(w_str).ListColumns.Count > 20 Then .Orientation = xlVertical End If .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With
Range(w_str & "[#All]").Select Selection.ColumnWidth = 50 Selection.Columns.AutoFit Selection.Rows.AutoFit For Each w_range In ActiveSheet.ListObjects(w_str).HeaderRowRange Select Case w_range.Value Case "日付", "作成日", "更新日" w_range.EntireColumn.NumberFormatLocal = "yyyy-mm-dd;@" w_range.EntireColumn.AutoFit ActiveSheet.DisplayPageBreaks = False End Select Next w_range On Error GoTo l_wnd Range("t_時間集計[#Headers]").Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlTop .WrapText = False .Orientation = xlVertical .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("t_時間集計[#All]").Select Selection.Columns.AutoFit l_end: Rows("2:2").Select ActiveWindow.FreezePanes = True Range("A1").Select
End Sub
比較
比較
Sub シート_比較()
'シートを比較する
Dim s1 As Worksheet Dim s2 As Worksheet Dim s3 As Worksheet Dim r_end As Long Dim r1_end As Long Dim r2_end As Long Dim r3_end As Long
Dim c_end As Long Dim c1_end As Long Dim c2_end As Long Dim c3_end As Long Dim i As Long Dim j As Long
Set s1 = Sheets("旧") Set s2 = Sheets("新") Set s3 = Sheets("比較結果")
s3.Activate
With s1.UsedRange r1_end = .Row + .Rows.Count - 1 c1_end = .Column + .Columns.Count - 1 End With
With s2.UsedRange r2_end = .Row + .Rows.Count - 1 c2_end = .Column + .Columns.Count - 1 End With
With s3.UsedRange r3_end = .Row + .Rows.Count - 1 c3_end = .Column + .Columns.Count - 1 End With If r1_end > r2_end Then r_end = r1_end Else r_end = r2_end End If If c1_end > c2_end Then c_end = c1_end Else c_end = c2_end End If With s1 .Activate .Cells.Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With .Rows("1:1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With .Columns("A:A").Select With Selection.Interior .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With End With With s2 .Activate .Cells.Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With .Rows("1:1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With .Columns("A:A").Select With Selection.Interior .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With End With With s3 .Activate .Cells.Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.ClearContents .Rows("1:1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.ClearContents .Columns("A:A").Select With Selection.Interior .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.ClearContents End With For i = 2 To r_end Application.StatusBar = i For j = 2 To c_end If s1.Cells(i, j).Value <> s2.Cells(i, j).Value Then s3.Cells(i, j).Value = "●" If Trim(s1.Cells(i, j).Value) = "" Or Trim(s2.Cells(i, j).Value) = "" Then s1.Cells(i, j).Interior.ColorIndex = 15 '薄灰 s2.Cells(i, j).Interior.ColorIndex = 15 '薄灰 s3.Cells(i, j).Interior.ColorIndex = 15 '薄灰 Else s1.Cells(i, j).Interior.ColorIndex = 3 '赤 s2.Cells(i, j).Interior.ColorIndex = 3 '赤 s3.Cells(i, j).Interior.ColorIndex = 3 '赤 End If s1.Cells(i, 1).Value = s3.Cells(i, 1).Value + 1 s1.Cells(1, j).Value = s3.Cells(1, j).Value + 1 s2.Cells(i, 1).Value = s3.Cells(i, 1).Value + 1 s2.Cells(1, j).Value = s3.Cells(1, j).Value + 1 s3.Cells(i, 1).Value = s3.Cells(i, 1).Value + 1 s3.Cells(1, j).Value = s3.Cells(1, j).Value + 1 End If Next j Next i
With s1 For i = 2 To r_end If .Cells(i, 1).Value > 0 Then .Cells(i, 1).Interior.ColorIndex = 3 End If Next i For j = 2 To c_end If .Cells(1, j).Value > 0 Then .Cells(1, j).Interior.ColorIndex = 3 End If Next j End With
With s2 For i = 2 To r_end If .Cells(i, 1).Value > 0 Then .Cells(i, 1).Interior.ColorIndex = 3 End If Next i For j = 2 To c_end If .Cells(1, j).Value > 0 Then .Cells(1, j).Interior.ColorIndex = 3 End If Next j End With With s3 For i = 2 To r_end If .Cells(i, 1).Value > 0 Then .Cells(i, 1).Interior.ColorIndex = 3 End If Next i For j = 2 To c_end If .Cells(1, j).Value > 0 Then .Cells(1, j).Interior.ColorIndex = 3 End If Next j End With MsgBox "終了" Application.StatusBar = False
End Sub
'シートを比較する
Dim s1 As Worksheet Dim s2 As Worksheet Dim s3 As Worksheet Dim r_end As Long Dim r1_end As Long Dim r2_end As Long Dim r3_end As Long
Dim c_end As Long Dim c1_end As Long Dim c2_end As Long Dim c3_end As Long Dim i As Long Dim j As Long
Set s1 = Sheets("旧") Set s2 = Sheets("新") Set s3 = Sheets("比較結果")
s3.Activate
With s1.UsedRange r1_end = .Row + .Rows.Count - 1 c1_end = .Column + .Columns.Count - 1 End With
With s2.UsedRange r2_end = .Row + .Rows.Count - 1 c2_end = .Column + .Columns.Count - 1 End With
With s3.UsedRange r3_end = .Row + .Rows.Count - 1 c3_end = .Column + .Columns.Count - 1 End With If r1_end > r2_end Then r_end = r1_end Else r_end = r2_end End If If c1_end > c2_end Then c_end = c1_end Else c_end = c2_end End If With s1 .Activate .Cells.Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With .Rows("1:1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With .Columns("A:A").Select With Selection.Interior .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With End With With s2 .Activate .Cells.Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With .Rows("1:1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With .Columns("A:A").Select With Selection.Interior .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With End With With s3 .Activate .Cells.Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.ClearContents .Rows("1:1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.ClearContents .Columns("A:A").Select With Selection.Interior .PatternColorIndex = xlAutomatic .Color = 15773696 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.ClearContents End With For i = 2 To r_end Application.StatusBar = i For j = 2 To c_end If s1.Cells(i, j).Value <> s2.Cells(i, j).Value Then s3.Cells(i, j).Value = "●" If Trim(s1.Cells(i, j).Value) = "" Or Trim(s2.Cells(i, j).Value) = "" Then s1.Cells(i, j).Interior.ColorIndex = 15 '薄灰 s2.Cells(i, j).Interior.ColorIndex = 15 '薄灰 s3.Cells(i, j).Interior.ColorIndex = 15 '薄灰 Else s1.Cells(i, j).Interior.ColorIndex = 3 '赤 s2.Cells(i, j).Interior.ColorIndex = 3 '赤 s3.Cells(i, j).Interior.ColorIndex = 3 '赤 End If s1.Cells(i, 1).Value = s3.Cells(i, 1).Value + 1 s1.Cells(1, j).Value = s3.Cells(1, j).Value + 1 s2.Cells(i, 1).Value = s3.Cells(i, 1).Value + 1 s2.Cells(1, j).Value = s3.Cells(1, j).Value + 1 s3.Cells(i, 1).Value = s3.Cells(i, 1).Value + 1 s3.Cells(1, j).Value = s3.Cells(1, j).Value + 1 End If Next j Next i
With s1 For i = 2 To r_end If .Cells(i, 1).Value > 0 Then .Cells(i, 1).Interior.ColorIndex = 3 End If Next i For j = 2 To c_end If .Cells(1, j).Value > 0 Then .Cells(1, j).Interior.ColorIndex = 3 End If Next j End With
With s2 For i = 2 To r_end If .Cells(i, 1).Value > 0 Then .Cells(i, 1).Interior.ColorIndex = 3 End If Next i For j = 2 To c_end If .Cells(1, j).Value > 0 Then .Cells(1, j).Interior.ColorIndex = 3 End If Next j End With With s3 For i = 2 To r_end If .Cells(i, 1).Value > 0 Then .Cells(i, 1).Interior.ColorIndex = 3 End If Next i For j = 2 To c_end If .Cells(1, j).Value > 0 Then .Cells(1, j).Interior.ColorIndex = 3 End If Next j End With MsgBox "終了" Application.StatusBar = False
End Sub
簡易比較
簡易比較
Sub シート_簡易比較()
'シートを簡易比較する
Dim s1 As Worksheet Dim s2 As Worksheet Dim r_end As Long Dim c_end As Long Dim i As Long Dim j As Long
Set s1 = Worksheets(1) Set s2 = Worksheets(2) With s1.UsedRange r_end = .Row + .Rows.Count - 1 c_end = .Column + .Columns.Count - 1 End With s1.Range(s1.Cells(2, 1), s1.Cells(r_end, c_end)).Interior.ColorIndex = xlColorIndexNone s2.Range(s2.Cells(2, 1), s2.Cells(r_end, c_end)).Interior.ColorIndex = xlColorIndexNone
For i = 2 To r_end Application.StatusBar = i For j = 1 To c_end If s1.Cells(i, j).Value <> s2.Cells(i, j).Value Then s1.Cells(i, j).Interior.ColorIndex = 6 s2.Cells(i, j).Interior.ColorIndex = 6 End If Next j Next i
MsgBox "終了" Application.StatusBar = False
End Sub
'シートを簡易比較する
Dim s1 As Worksheet Dim s2 As Worksheet Dim r_end As Long Dim c_end As Long Dim i As Long Dim j As Long
Set s1 = Worksheets(1) Set s2 = Worksheets(2) With s1.UsedRange r_end = .Row + .Rows.Count - 1 c_end = .Column + .Columns.Count - 1 End With s1.Range(s1.Cells(2, 1), s1.Cells(r_end, c_end)).Interior.ColorIndex = xlColorIndexNone s2.Range(s2.Cells(2, 1), s2.Cells(r_end, c_end)).Interior.ColorIndex = xlColorIndexNone
For i = 2 To r_end Application.StatusBar = i For j = 1 To c_end If s1.Cells(i, j).Value <> s2.Cells(i, j).Value Then s1.Cells(i, j).Interior.ColorIndex = 6 s2.Cells(i, j).Interior.ColorIndex = 6 End If Next j Next i
MsgBox "終了" Application.StatusBar = False
End Sub
使用範囲設定
使用範囲設定
Sub シート_使用範囲設定()
Dim s As Worksheet Dim r_start As Long Dim r_end As Long Dim c_start As Long Dim c_end As Long Dim i As Long Dim j As Long Set s = ActiveSheet With s.UsedRange r_start = .Row r_end = .Row + .Rows.Count - 1 c_start = .Column c_end = .Column + .Columns.Count - 1 End With End Sub
Dim s As Worksheet Dim r_start As Long Dim r_end As Long Dim c_start As Long Dim c_end As Long Dim i As Long Dim j As Long Set s = ActiveSheet With s.UsedRange r_start = .Row r_end = .Row + .Rows.Count - 1 c_start = .Column c_end = .Column + .Columns.Count - 1 End With End Sub
条件付き書式
条件付き書式
Option Explicit
Sub シート_条件付き書式_入力様式() '条件付き書式を設定する。 Dim s As Worksheet Dim c_end As Integer Dim c_end_gyou As Integer Dim c_end_address As String Cells.FormatConditions.Delete Set s = ActiveSheet With s.UsedRange c_end = .Column + .Columns.Count - 1 End With Range("C1").Select Range(Selection, Selection.End(xlToRight)).Select With Selection c_end_gyou = .Column + .Columns.Count - 1 End With '重複 Rows("3:3").Select Selection.FormatConditions.AddUniqueValues Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).DupeUnique = xlDuplicate With Selection.FormatConditions(1).Font .Color = -16383844 .TintAndShade = 0 End With With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 13551615 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
'空白を赤色 Range(Range("C3"), Cells(3, c_end_gyou)).Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=C14=""""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
'空白を灰色 Range(Range("C2"), Cells(13, c_end_gyou)).Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AND(C$2="""",C$5="""",C$8="""",C$11="""")" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -0.249946592608417 End With Selection.FormatConditions(1).StopIfTrue = False
'エラーを赤色 Cells.Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ISNA(A1)" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
'エラーを赤色 Cells(19, c_end).Select c_end_address = Selection.Address(RowAbsolute:=False) Range("B19:B23").Select Application.Union(Selection, Range("B34:B38")).Select Application.Union(Selection, Range("B49:B53")).Select Application.Union(Selection, Range("B64:B68")).Select Selection.FormatConditions.Add Type:=xlExpression, _ Formula1:="=COUNTIF($C19:" & c_end_address & ",""●"")+SUMPRODUCT(ISERROR($C19:" & c_end_address & ")*1)>0" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
End Sub
Sub シート_条件付き書式_入力様式() '条件付き書式を設定する。 Dim s As Worksheet Dim c_end As Integer Dim c_end_gyou As Integer Dim c_end_address As String Cells.FormatConditions.Delete Set s = ActiveSheet With s.UsedRange c_end = .Column + .Columns.Count - 1 End With Range("C1").Select Range(Selection, Selection.End(xlToRight)).Select With Selection c_end_gyou = .Column + .Columns.Count - 1 End With '重複 Rows("3:3").Select Selection.FormatConditions.AddUniqueValues Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).DupeUnique = xlDuplicate With Selection.FormatConditions(1).Font .Color = -16383844 .TintAndShade = 0 End With With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 13551615 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
'空白を赤色 Range(Range("C3"), Cells(3, c_end_gyou)).Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=C14=""""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
'空白を灰色 Range(Range("C2"), Cells(13, c_end_gyou)).Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AND(C$2="""",C$5="""",C$8="""",C$11="""")" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -0.249946592608417 End With Selection.FormatConditions(1).StopIfTrue = False
'エラーを赤色 Cells.Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ISNA(A1)" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
'エラーを赤色 Cells(19, c_end).Select c_end_address = Selection.Address(RowAbsolute:=False) Range("B19:B23").Select Application.Union(Selection, Range("B34:B38")).Select Application.Union(Selection, Range("B49:B53")).Select Application.Union(Selection, Range("B64:B68")).Select Selection.FormatConditions.Add Type:=xlExpression, _ Formula1:="=COUNTIF($C19:" & c_end_address & ",""●"")+SUMPRODUCT(ISERROR($C19:" & c_end_address & ")*1)>0" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
End Sub
条件付き書式_QAシート
条件付き書式_QAシート
Sub シート_条件付き書式_QAシート() Cells.FormatConditions.Delete '完了を灰色 Range("I3:M1048576").Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:= "=$K3=""完了""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -0.14996795556505 End With Selection.FormatConditions(1).StopIfTrue = False
End Sub
End Sub
条件付き書式_入力様式
条件付き書式_入力様式
Sub シート_条件付き書式_入力様式() '条件付き書式を設定する。 Dim c_end As Integer Cells.FormatConditions.Delete '重複 Rows("3:3").Select Selection.FormatConditions.AddUniqueValues Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority Selection.FormatConditions(1).DupeUnique = xlDuplicate With Selection.FormatConditions(1).Font .Color = -16383844 .TintAndShade = 0 End With With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 13551615 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
'空白を赤色 Range("B14").Select Range(Selection, Selection.End(xlToRight)).Select With Selection c_end = .Column + .Columns.Count - 1 End With Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=B14=""""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
'空白を灰色 Range(Range("B2"), Cells(13, c_end)).Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AND(B$2="""",B$5="""",B$8="""",B$11="""")" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -0.249946592608417 End With Selection.FormatConditions(1).StopIfTrue = False
'エラーを赤色 Range("B19:B23").Select Application.Union(Selection, Range("B34:B38")).Select Application.Union(Selection, Range("B49:B53")).Select Application.Union(Selection, Range("B64:B68")).Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF($C19:$XFD19,""●"")+SUMPRODUCT(ISERROR($C19:$XFD19)*1)>0" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
'エラーを赤色 Cells.Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ISNA(A1)" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
End Sub
'空白を赤色 Range("B14").Select Range(Selection, Selection.End(xlToRight)).Select With Selection c_end = .Column + .Columns.Count - 1 End With Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=B14=""""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
'空白を灰色 Range(Range("B2"), Cells(13, c_end)).Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=AND(B$2="""",B$5="""",B$8="""",B$11="""")" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -0.249946592608417 End With Selection.FormatConditions(1).StopIfTrue = False
'エラーを赤色 Range("B19:B23").Select Application.Union(Selection, Range("B34:B38")).Select Application.Union(Selection, Range("B49:B53")).Select Application.Union(Selection, Range("B64:B68")).Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF($C19:$XFD19,""●"")+SUMPRODUCT(ISERROR($C19:$XFD19)*1)>0" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
'エラーを赤色 Cells.Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ISNA(A1)" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False
End Sub
条件付き書式_動作確認
条件付き書式_動作確認
Sub シート_条件付き書式_動作確認() 'シートの条件付き書式を設定しなおす。 Cells.FormatConditions.Delete Range("E:E,J:J,O:O").Select Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""NG""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 13551615 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = True Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""NG→既存バグ""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 10284031 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = True Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""NG→OK""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 10284031 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = True Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""環境設定要""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 10284031 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = True Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""OK""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent1 .TintAndShade = 0.799981688894314 End With Selection.FormatConditions(1).StopIfTrue = True Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""OK（データ無）""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent1 .TintAndShade = 0.799981688894314 End With Selection.FormatConditions(1).StopIfTrue = True End Sub
ズーム
ズーム
Sub シート_ズーム() 'シートのzoomを変更する。 If ActiveWindow.Zoom = 100 Then ActiveWindow.Zoom = 150 ElseIf ActiveWindow.Zoom = 150 Then ActiveWindow.Zoom = 200 Else ActiveWindow.Zoom = 100 End If End Sub