vba 선택한 셀 주소 배열에 담아서 합계 처리

선택한셀주소배열에담기.xlsm

0.02MB

Sub CheckAndProcessVisibleCells()
    Dim selectedRange As Range
    Dim visibleCells As Range
    Dim cell As Range
    Dim cellAddresses() As String
    Dim i As Integer
    Dim ws As Worksheet
    Dim bSum As Double
    Dim cSum As Double

    ' 현재 워크시트를 설정합니다.
    Set ws = ActiveSheet

    ' 선택된 범위를 가져옴
    Set selectedRange = Selection

    ' 보이는 셀만 필터링
    On Error Resume Next ' 에러 처리: 필터링된 셀이 없는 경우
    Set visibleCells = selectedRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0 ' 에러 처리 복구

    ' 초기화
    bSum = 0
    cSum = 0
    i = 1

    ' 배열 크기 초기 설정
    ReDim cellAddresses(1 To 1)

    ' 보이는 셀 중 값이 있는 셀의 주소를 배열에 저장하고 B열과 C열 값의 합을 계산
    For Each cell In visibleCells
        If Not IsEmpty(cell.Value) Then
            ' 배열 크기 재설정
            If i > 1 Then
                ReDim Preserve cellAddresses(1 To i)
            End If
            
            cellAddresses(i) = cell.Address
            bSum = bSum + ws.Cells(cell.Row, 2).Value ' B열 값
            cSum = cSum + ws.Cells(cell.Row, 3).Value ' C열 값
            i = i + 1
        End If
    Next cell

    ' 값이 있는 셀을 찾은 경우에만 처리
    If i > 1 Then
        ' B열 값의 합과 C열 값의 합을 비교
        If bSum = cSum Then
            ' 합이 같으면 선택한 셀의 색을 지우고 D열에 숫자 0을 입력
            For i = LBound(cellAddresses) To UBound(cellAddresses)
                ws.Range(cellAddresses(i)).Interior.ColorIndex = xlNone
                ws.Cells(ws.Range(cellAddresses(i)).Row, 4).Value = 0 ' D열에 숫자 0 입력
            Next i
        Else
            ' 합이 다르면 메시지 박스 띄우기
            MsgBox "B열 합은 " & Format(bSum, "#,##0") & vbCrLf & "C열 합은 " & Format(cSum, "#,##0") & vbCrLf & "이므로 합이 일치하지 않습니다", vbExclamation
        End If
    Else
        ' 값이 있는 보이는 셀이 없는 경우
        MsgBox "선택한 셀 중 값이 있는 보이는 셀이 없습니다", vbInformation
    End If

End Sub