vba 엑셀 메모 추출해서 뿌려주기

2019. 9. 11. 13:16VBA/VBA활용

728x90
반응형

 

보통 엑셀로 업무를 하다보면 메모에 내용을 적어두고 업무를 할 때가 있는데요.

이럴 때 이 메모 내용이 중구난방으로 뿌려지는 경우가 있어

취합을 한다거나? 아니면 메모 내용을 한 번에 보고 싶은 경우가 생깁니다.

이럴 때 VBA로 추출을 할 수 있습니다.

추출을 하게 되면 아래와 같은 모습이 됩니다.

메모 뽑아내기 사용법!

① ALT + F11 을 눌러 편집기가 뜨게 한다.

② 아래 "현재_통합_문서" 를 더블클릭 한다.

③ 아래 코드를 우측에 붙여 넣는다.

④ 편집기를 끄고, [보기] 탭의 매크로를 누르고 [매크로 보기(V)] 를 눌러 아래 매크로를 실행 한다.

⑤ 매크로가 실행이 되면 절차대로 하면 된다.

- 범위를 드래그하여 선택

- 사진처럼 뿌려질 위치를 클릭

소스 코드

Public Sub 악마성_메모추출()
    Dim rng As Range
    Dim targetRng As Range
    On Error Resume Next
      '// 사용자에게 보여지는 박스 팝업을 보여주는 부분 입니다.
      Set rng = Application.InputBox( _
        Title:="붙혀넣을 범위를 선택하세요.", _
        prompt:="드래그하여 붙여넣어도 되고, 직접 입력해도 됩니다. ㅎ", _
        Type:=8)
        '// 최종적으로는 rng 라는 범위에 사용자가 드래그한 범위를 저장 합니다.
      ' 메모를 쫘악 추출해서 뿌려줄 위치 셀을 찍습니다.
      Set targetRng = Application.InputBox(Title:="결과표시 할 셀을 선택하세요.", prompt:="ex) [A10] 선택", Type:=8)
    On Error GoTo 0
    ' Sheet 를 변수에 할당합니다.
    Dim ms As Worksheet
    Set ms = Workbooks(ThisWorkbook.Name).Sheets(ActiveSheet.Name)
    
    Dim rn As Range
    Dim r As Integer
    
    r = targetRng.Row
    c = targetRng.Column
    
    For Each rn In rng
        If Not rn.Comment Is Nothing Then
          ms.Cells(r, c) = rn.Comment.Text
          r = r + 1
        End If
    Next
End Sub

 

 

728x90
반응형