엑셀 매크로 VBA 7. 나의 함수 : 값을 곱할 값을 입력받아 곱셈 소스코드

엑셀 매크로 VBA 7. 나의 함수 : 값을 곱할 값을 입력받아 곱셈 소스코드

숫자가 들어있는 셀을 블럭으로 선택해서 일정한 값으로 곱셈을 실행한다

Sub 값을곱하기()

    Dim sela1 As Range

   

    Dim i As Long

    Dim j As Long

    Dim startx As Long

    Dim starty As Long

    Dim lenx As Long

    Dim leny As Long

    Dim strVal As String

    Dim valNo As Double

    

    On Error GoTo ERR1

    Set sela1 = Application.InputBox(Type:=8, prompt:="영역을 선택하세요(단일블럭으로선택) ?", Title:="값곱하기")

     

    strVal = InputBox("곱할값은 ? ", "입력", "1000")

    If strVal = "" Then Exit Sub

    valNo = CDbl(strVal)

    

    startx = CLng(sela1.Column)

    starty = CLng(sela1.row)

    lenx = CLng(sela1.Columns(sela1.Columns.Count).Column) - CLng(sela1.Column) + 1

    leny = CLng(sela1.Rows(sela1.Rows.Count).row) - CLng(sela1.row) + 1

Dim vvv As String

    For i = startx - 1 To lenx + startx - 2

        For j = starty To leny + starty - 1

            vvv = Range(Chr(65 + i) & j).Value

            vvv = vvv * valNo

            Range(Chr(65 + i) & j).Formula = vvv

        Next

    Next

    

ERR1:

End Sub

.