사용자 함수를 찾는 vba 코드 입니다 (2)

Option Explicit

Sub UserFn_Find()' === 모듈 시작
' CodeBy [ 오즈맨 ] , Date : 2014-08-21

'루프 변수
Dim ii    As Double
Dim jj    As Double
Dim kk    As Double
Dim pp    As Double
Dim MySheet    As Worksheet

Dim TheLink As Variant        '외부링크 파일 찾아 저장
Dim My_Link As Variant        '그 중 사용자 함수만 추출

Dim tmpString As String
Dim tmpArray() As String      '목록을 임시로 저장하는 변수

TheLink = ActiveWorkbook.LinkSources(xlExcelLinks) '링크 차즌 담
kk = UBound(TheLink)          '개수를 세어보고

jj = 1
ReDim My_Link(1 To 2, 1 To jj) As Variant
      My_Link(1, 1) = "Path"
      My_Link(2, 1) = "File"

For ii = 1 To kk                   '링크 개수만큼 루프 돌되
     tmpString = TheLink(ii)            '임시 문자열에 링크명을 넣고
     pp = InStrRev(tmpString, "\")
     tmpString = Mid(tmpString, pp + 1) '임시문자열에서 파일명만 추출합니다
     
     If Workbooks(tmpString).IsAddin = True Then  '추가기능일 경우만 재적립 시킴
          jj = jj + 1
          ReDim Preserve My_Link(1 To 2, 1 To jj) As Variant
               My_Link(1, jj) = TheLink(ii)       '차후 File Open 용
               My_Link(2, jj) = tmpString         'UDF Find 용
     End If
     
Next


'찾기를 위한 임시변수
Dim c As Range, rng As Range
Dim tmpAddress As String


If jj < 2 Then
          MsgBox " 이 파일에는 읍사와유 ", , "그럼 이만..."
          Exit Sub
End If


Set rng = Application.InputBox(vbLf & "   가로로 네(4) 열 차지합니다", "   기록할 셀 지정합니다.", Type:=8)

pp = UBound(My_Link, 2)
For ii = 2 To pp                        '일단 닫고
     Workbooks(My_Link(2, ii)).Close
Next


jj = 1
ReDim tmpArray(1 To 4, 1 To jj) As String
     tmpArray(1, 1) = "추가기능 File"
     tmpArray(2, 1) = "사용된 시트"
     tmpArray(3, 1) = "셀 주소"
     tmpArray(4, 1) = "수식"


'여기서 파일명 검색으로 뒤져봅니다
For ii = 2 To pp
tmpString = My_Link(1, ii)
For Each MySheet In ActiveWorkbook.Sheets              '워크북에서 시트를 돌며 검색합니다.
     
     With MySheet.Cells                                '시트에서 ...
          Set c = .Find(tmpString, LookIn:=xlFormulas)      '해당 파일명을 검색합니다.
          If Not c Is Nothing Then
                    tmpAddress = c.Address
               Do
                    jj = jj + 1                             '만일 있으면 누적시켜 저장합니다.
                    ReDim Preserve tmpArray(1 To 4, 1 To jj) As String
                         tmpArray(1, jj) = tmpString        '파일명
                         tmpArray(2, jj) = MySheet.Name     '사용된 시트명
                         tmpArray(3, jj) = c.AddressLocal(0, 0)  '셀 주소
                         tmpArray(4, jj) = c.Formula         '수식
               Set c = .FindNext(c)
               Loop While Not c Is Nothing And c.Address <> tmpAddress
          End If
     End With
     
Next
Next


For ii = 2 To pp                       '닫은 추가기능을 다시 열고
     Workbooks.Open Filename:=My_Link(1, ii)
     Application.Volatile
Next
     

'그 결과를 행/열을 바꿔서 배열로 만들고
Dim TheAnswer
ReDim TheAnswer(1 To jj, 1 To 4)

For kk = 1 To 4
     TheAnswer(1, kk) = tmpArray(kk, 1)
Next


For ii = 2 To jj
For kk = 1 To 4
     TheAnswer(ii, kk) = tmpArray(kk, ii)
Next

     tmpString = TheAnswer(ii, 1)
     TheAnswer(ii, 1) = Mid(tmpString, InStrRev(tmpString, "\") + 1)
     
     tmpString = TheAnswer(ii, 4)
     TheAnswer(ii, 4) = " =" & Mid(tmpString, InStrRev(tmpString, "!") + 1)
     
Next

'바뀐 결과를 셀에 기록합니다
rng.Resize(jj, 4) = TheAnswer


'변수 초기화 마무리는 직접 하시기 바랍니다.


End Sub         ' ___ 모듈 종료

http://ozman.tistory.com/113 글의 신 버전입니다