Option Explicit
'새 버전으로 이동합니다'
Sub UserFunctionFind()' === 모듈 시작
' CodeBy [ User_1 ] , Date : 2009-05-26
On Error Resume Next
Dim Linked As Variant, Strs As String
Dim LnkArr As Variant
Linked = ActiveWorkbook.LinkSources(xlExcelLinks) '링크 차즌 담
Dim i As Double, j As Double
Dim c As Range, rng As Range
Dim Addr As String, AnsAll
Dim AnsAdd As New Collection '셀 주소 누적용
If UBound(Linked) = 0 Then
MsgBox " 이 시트에는 읍네요", , "그럼 이만..."
Exit Sub
End If
Set rng = Application.InputBox(vbLf & " 가로로 두 열 차지합니다", " 기록할 셀 지정", Type:=8)
ReDim LnkArr(1 To UBound(Linked), 1 To 2)
For i = 1 To UBound(Linked)
LnkArr(i, 1) = Linked(i) '배열 1 째에는 전체이름
For j = 1 To Len(LnkArr(i, 1)) '폴더 명과 파일 구분
Strs = Strs & Mid(LnkArr(i, 1), j, 1)
If CStr(Mid(LnkArr(i, 1), j, 1)) = "\" Then Strs = ""
Next
LnkArr(i, 2) = Strs '배열 2 째에 파일명
Next
For i = 1 To UBound(Linked) '일단 닫고
Workbooks(LnkArr(i, 2)).Close
Next
i = 0
Strs = Left(Strs, InStr(1, Strs, ".") - 1)
With ActiveSheet.Cells '찾기 시작
Set c = .Find(Strs, LookIn:=xlFormulas)
If Not c Is Nothing Then
Addr = c.Address
Do
i = i + 1
AnsAdd.Add c.AddressLocal(0, 0), CStr(c.AddressLocal(0, 0))
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Addr
End If
End With
For i = 1 To UBound(Linked)
Workbooks.Open Filename:=LnkArr(i, 1)
Application.Volatile
Next
ReDim AnsAll(1 To AnsAdd.Count + 1, 1 To 2)
AnsAll(1, 1) = "셀 주소"
AnsAll(1, 2) = "수식"
For i = 1 To AnsAdd.Count
AnsAll(i + 1, 1) = AnsAdd(i)
AnsAll(i + 1, 2) = "'" & Range(AnsAdd(i)).Formula
Next
rng.Resize(AnsAdd.Count + 1, 2) = AnsAll
End Sub ' ___ 모듈 종료
'새 버전으로 이동합니다'
Sub UserFunctionFind()' === 모듈 시작
' CodeBy [ User_1 ] , Date : 2009-05-26
On Error Resume Next
Dim Linked As Variant, Strs As String
Dim LnkArr As Variant
Linked = ActiveWorkbook.LinkSources(xlExcelLinks) '링크 차즌 담
Dim i As Double, j As Double
Dim c As Range, rng As Range
Dim Addr As String, AnsAll
Dim AnsAdd As New Collection '셀 주소 누적용
If UBound(Linked) = 0 Then
MsgBox " 이 시트에는 읍네요", , "그럼 이만..."
Exit Sub
End If
Set rng = Application.InputBox(vbLf & " 가로로 두 열 차지합니다", " 기록할 셀 지정", Type:=8)
ReDim LnkArr(1 To UBound(Linked), 1 To 2)
For i = 1 To UBound(Linked)
LnkArr(i, 1) = Linked(i) '배열 1 째에는 전체이름
For j = 1 To Len(LnkArr(i, 1)) '폴더 명과 파일 구분
Strs = Strs & Mid(LnkArr(i, 1), j, 1)
If CStr(Mid(LnkArr(i, 1), j, 1)) = "\" Then Strs = ""
Next
LnkArr(i, 2) = Strs '배열 2 째에 파일명
Next
For i = 1 To UBound(Linked) '일단 닫고
Workbooks(LnkArr(i, 2)).Close
Next
i = 0
Strs = Left(Strs, InStr(1, Strs, ".") - 1)
With ActiveSheet.Cells '찾기 시작
Set c = .Find(Strs, LookIn:=xlFormulas)
If Not c Is Nothing Then
Addr = c.Address
Do
i = i + 1
AnsAdd.Add c.AddressLocal(0, 0), CStr(c.AddressLocal(0, 0))
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Addr
End If
End With
For i = 1 To UBound(Linked)
Workbooks.Open Filename:=LnkArr(i, 1)
Application.Volatile
Next
ReDim AnsAll(1 To AnsAdd.Count + 1, 1 To 2)
AnsAll(1, 1) = "셀 주소"
AnsAll(1, 2) = "수식"
For i = 1 To AnsAdd.Count
AnsAll(i + 1, 1) = AnsAdd(i)
AnsAll(i + 1, 2) = "'" & Range(AnsAdd(i)).Formula
Next
rng.Resize(AnsAdd.Count + 1, 2) = AnsAll
End Sub ' ___ 모듈 종료
'엑셀보조파일,기능,함수' 카테고리의 다른 글
| 10진수를 2진수로 변환하기(내장함수 한계극복) (0) | 2015.06.23 |
|---|---|
| 숫자... 지수형식 오류 (0) | 2015.05.14 |
| 사용자 함수를 찾는 vba 코드 입니다 (2) (0) | 2014.08.21 |
| [ 문자열 비교하는 사용자 함수 ] 예제 입니다. (1) | 2009.03.29 |
| Word, Excel 및 PowerPoint 2007 파일 형식용 Microsoft Office 호환팩 (2) | 2009.03.24 |
| 수식에서 사용하는 -- 의 역할 예제 입니다. (1) | 2009.02.10 |
| 매크로 보안으로 안전하게 인증서 -1 인증서 만들기 사용하기 지우기 (0) | 2009.01.23 |
