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 글의 신 버전입니다
'엑셀보조파일,기능,함수' 카테고리의 다른 글
| 수식에서의 -- 역할 및 SUMPRODUCT 함수 예제 입니다. (1) | 2016.03.02 |
|---|---|
| 10진수를 2진수로 변환하기(내장함수 한계극복) (0) | 2015.06.23 |
| 숫자... 지수형식 오류 (0) | 2015.05.14 |
| 사용자 함수를 찾는 vba 코드 입니다. (0) | 2009.05.26 |
| [ 문자열 비교하는 사용자 함수 ] 예제 입니다. (1) | 2009.03.29 |
| Word, Excel 및 PowerPoint 2007 파일 형식용 Microsoft Office 호환팩 (2) | 2009.03.24 |
| 수식에서 사용하는 -- 의 역할 예제 입니다. (1) | 2009.02.10 |
