엑셀 매크로 VBA 9. 나의 함수 : 여러셀 선택기 소스코드

엑셀 매크로 VBA 9. 나의 함수 : 여러셀 선택기 소스코드

셀을 선택해서 반복해서 선택한다.(?)

Option Explicit

  Dim startx As Long

  Dim starty As Long

  Dim lenx As Long

  

  Dim leny As Long

  Dim basex As Long

  Dim basey As Long

  Dim refx As Long

  Dim refy As Long

  Dim idx As Long

Sub 여러칸선택기()

    Dim a

    Dim sela1 As Range

    Dim sela2 As Range

    Dim sela3 As Range

    Dim cnts As String

    Dim cnt As Long

    

    Dim incx As Long

    Dim incy As Long

       

    Dim i As Long

    Dim j As Long

    

    On Error GoTo errhandler

    

    Set sela2 = Application.InputBox(Type:=8, prompt:="기준 셀을 선택하세요 ?", Title:="틀반복복사기")

    basex = CLng(sela2.Column)

    basey = CLng(sela2.row)

    

    Set sela3 = Application.InputBox(Type:=8, prompt:="이동 셀을 선택하세요 ?", Title:="틀반복복사기")

    refx = CLng(sela3.Column)

    refy = CLng(sela3.row)

    

    incx = refx - basex

    incy = refy - basey

    cnts = InputBox("반복회수를 입력하세요 ?", "틀반복복사기")

    cnt = CLng(cnts)

    

    Dim tArea As String

    Dim tArea2 As String

    Dim strRC As String

    

    For idx = 0 To cnt - 1

        a = Chr(65 + basex + incx * idx - 1) & Trim(Str(basey + incy * idx))

        Range(a).Select

        If Not idx = cnt Then

            strRC = "R" & Trim(Str(basey + incy * idx)) & "C" & Trim(Str(basex + incx * idx))

            tArea = strRC + "," + tArea

            tArea2 = a + "," + tArea2

        End If

    Next

        tArea2 = tArea2 + a

        tArea = tArea + strRC

        Range(tArea2).Select

        Dim strName As String

        strName = InputBox("영역의 이름은 ?", "이름정의")

        ActiveWorkbook.Names.Add Name:=strName, RefersToR1C1:="=" & tArea

    Exit Sub

errhandler:

    MsgBox "에러가 발생하여 작업을 취소하였습니다"

End Sub

.