excel vba 数式と条件式書式

# excel vba 数式と条件式書式

```ruby:CommandButton1_Click

Option Explicit

Private Sub CommandButton1_Click()
    Call calc2
End Sub

Private Sub calc2()
Dim rng As range, calRng As range
Dim retOff As Long, nexOff As Long, wrtOff As Long, i As Long
Dim strNo As String, nexNo As String
Dim srcRow As Long, dstRow As Long
    
    Set rng = range("A:A") _
    .Find(What:="■BOOK", LookAt:=xlWhole, SearchOrder:=xlByRows)
    
    '数式初期化
'    range("B7：AH16").Value = "－"
'    range("B7：AH16").HorizontalAlignment = xlCenter
'    range("B7：AH16").VerticalAlignment = xlCenter

    retOff = getTop(rng)
    If retOff = 18 Then
        strNo = "①"
    ElseIf retOff = 19 Then
        strNo = "②"
    ElseIf retOff = 20 Then
        strNo = "③"
    ElseIf retOff = 21 Then
        strNo = "④"
    ElseIf retOff = 22 Then
        strNo = "⑤"
    ElseIf retOff = 23 Then
        strNo = "⑥"
    ElseIf retOff = 24 Then
        strNo = "⑦"
    ElseIf retOff = 25 Then
        strNo = "⑧"
    ElseIf retOff = 26 Then
        strNo = "⑨"
    ElseIf retOff = 27 Then
        strNo = "⑩"
    ElseIf retOff = 28 Then
        strNo = "⑪"
    Else
        strNo = "$$"
    End If
    
    wrtOff = 4
    rng.Offset(wrtOff, 0).Value = ""
    rng.Offset(wrtOff + 1, 0).Value = ""
    rng.Offset(wrtOff + 2, 0).Value = ""
    rng.Offset(wrtOff + 3, 0).Value = ""
    rng.Offset(wrtOff + 4, 0).Value = ""
    rng.Offset(wrtOff + 5, 0).Value = ""
    rng.Offset(wrtOff + 6, 0).Value = ""
    rng.Offset(wrtOff + 7, 0).Value = ""
    rng.Offset(wrtOff + 8, 0).Value = ""
    rng.Offset(wrtOff + 9, 0).Value = ""
    For i = 1 To 33
        rng.Offset(wrtOff, i).Value = "－"
        rng.Offset(wrtOff, i).HorizontalAlignment = xlCenter
        rng.Offset(wrtOff, i).VerticalAlignment = xlCenter
        rng.Offset(wrtOff + 1, i).Value = "－"
        rng.Offset(wrtOff + 1, i).HorizontalAlignment = xlCenter
        rng.Offset(wrtOff + 1, i).VerticalAlignment = xlCenter
        rng.Offset(wrtOff + 2, i).Value = "－"
        rng.Offset(wrtOff + 2, i).HorizontalAlignment = xlCenter
        rng.Offset(wrtOff + 2, i).VerticalAlignment = xlCenter
        rng.Offset(wrtOff + 3, i).Value = "－"
        rng.Offset(wrtOff + 3, i).HorizontalAlignment = xlCenter
        rng.Offset(wrtOff + 3, i).VerticalAlignment = xlCenter
        rng.Offset(wrtOff + 4, i).Value = "－"
        rng.Offset(wrtOff + 4, i).HorizontalAlignment = xlCenter
        rng.Offset(wrtOff + 4, i).VerticalAlignment = xlCenter
        rng.Offset(wrtOff + 5, i).Value = "－"
        rng.Offset(wrtOff + 5, i).HorizontalAlignment = xlCenter
        rng.Offset(wrtOff + 5, i).VerticalAlignment = xlCenter
        rng.Offset(wrtOff + 6, i).Value = "－"
        rng.Offset(wrtOff + 6, i).HorizontalAlignment = xlCenter
        rng.Offset(wrtOff + 6, i).VerticalAlignment = xlCenter
        rng.Offset(wrtOff + 7, i).Value = "－"
        rng.Offset(wrtOff + 7, i).HorizontalAlignment = xlCenter
        rng.Offset(wrtOff + 7, i).VerticalAlignment = xlCenter
        rng.Offset(wrtOff + 8, i).Value = "－"
        rng.Offset(wrtOff + 8, i).HorizontalAlignment = xlCenter
        rng.Offset(wrtOff + 8, i).VerticalAlignment = xlCenter
        rng.Offset(wrtOff + 9, i).Value = "－"
        rng.Offset(wrtOff + 9, i).HorizontalAlignment = xlCenter
        rng.Offset(wrtOff + 9, i).VerticalAlignment = xlCenter
    Next i
    
    nexOff = retOff + 1
    For i = nexOff To 28
        If rng.Offset(i, 1).Value <> "マッピング定義書に項目なし" Then
            If i = 18 Then
                nexNo = "①"
            ElseIf i = 19 Then
                nexNo = "②"
            ElseIf i = 20 Then
                nexNo = "③"
            ElseIf i = 21 Then
                nexNo = "④"
            ElseIf i = 22 Then
                nexNo = "⑤"
            ElseIf i = 23 Then
                nexNo = "⑥"
            ElseIf i = 24 Then
                nexNo = "⑦"
            ElseIf i = 25 Then
                nexNo = "⑧"
            ElseIf i = 26 Then
                nexNo = "⑨"
            ElseIf i = 27 Then
                nexNo = "⑩"
            ElseIf i = 28 Then
                nexNo = "⑪"
            Else
                nexNo = "??"
            End If
            rng.Offset(wrtOff, 0).Value = strNo & "と" & nexNo & "項目内容比較"
            srcRow = rng.Offset(retOff, 0).Row
            dstRow = rng.Offset(i, 0).Row
            rng.Offset(wrtOff, 1).Formula = "=IF(B" & srcRow & "=B" & dstRow & ",""一致"",""不一致"")"
'            Dim fc As FormatCondition
''            fc = rng.Offset(wrtOff, 1).FormatConditions.ADD(xlCellValue, xlNotEqual, "一致", "")
''            fc.Interior.Color = RGB(255, 153, 255)         ' 背景
'            fc = range("B8").FormatConditions.ADD(xlCellValue, xlNotEqual, "一致", "")
'            fc.Interior.Color = RGB(255, 153, 255)         ' 背景
            rng.Offset(wrtOff, 2).Formula = "=IF(C" & srcRow & "=C" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 3).Formula = "=IF(D" & srcRow & "=D" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 4).Formula = "=IF(E" & srcRow & "=E" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 5).Formula = "=IF(F" & srcRow & "=F" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 6).Formula = "=IF(G" & srcRow & "=G" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 7).Formula = "=IF(H" & srcRow & "=H" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 8).Formula = "=IF(I" & srcRow & "=I" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 9).Formula = "=IF(J" & srcRow & "=J" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 10).Formula = "=IF(K" & srcRow & "=K" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 11).Formula = "=IF(L" & srcRow & "=L" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 12).Formula = "=IF(M" & srcRow & "=M" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 13).Formula = "=IF(N" & srcRow & "=N" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 14).Formula = "=IF(O" & srcRow & "=O" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 15).Formula = "=IF(P" & srcRow & "=P" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 16).Formula = "=IF(Q" & srcRow & "=Q" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 17).Formula = "=IF(R" & srcRow & "=R" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 18).Formula = "=IF(S" & srcRow & "=S" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 19).Formula = "=IF(T" & srcRow & "=T" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 20).Formula = "=IF(U" & srcRow & "=U" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 21).Formula = "=IF(V" & srcRow & "=V" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 22).Formula = "=IF(W" & srcRow & "=W" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 23).Formula = "=IF(X" & srcRow & "=X" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 24).Formula = "=IF(Y" & srcRow & "=Y" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 25).Formula = "=IF(Z" & srcRow & "=Z" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 26).Formula = "=IF(AA" & srcRow & "=AA" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 27).Formula = "=IF(AB" & srcRow & "=AB" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 28).Formula = "=IF(AC" & srcRow & "=AC" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 29).Formula = "=IF(AD" & srcRow & "=AD" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 30).Formula = "=IF(AE" & srcRow & "=AE" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 31).Formula = "=IF(AF" & srcRow & "=AF" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 32).Formula = "=IF(AG" & srcRow & "=AG" & dstRow & ",""一致"",""不一致"")"
            rng.Offset(wrtOff, 33).Formula = "=IF(AH" & srcRow & "=AH" & dstRow & ",""一致"",""不一致"")"
            wrtOff = wrtOff + 1
        End If
    Next i

End Sub

Private Function getTop(rng As range) As Long
Dim i As Long

    getTop = -1
    For i = 18 To 28
        If rng.Offset(i, 1).Value <> "マッピング定義書に項目なし" Then
            getTop = i
            Exit Function
        End If
    Next i
    
End Function

```