http://tone.tistory.com/93(VBA 다른 엑셀파일에 있는 셀값 가져오기)
있는 다른 엑셀파일을 열지 않고 가져오는 방식의 경우
많은 정보를 가져오려면 파일IO 를 이용하기 때문에 더럽게 느린 현상이 발생
그래서 이번에는 다른파일이 있다면 열어서 가져오자!
대상파일 : EffectTable.xlsm
작업 : 대상파일에 있는 DirectorKey,ActionDirectorKey,GetHitDirectorKey,GetHitObjectEffect 를
원본파일에 넣기
Private Sub CommandButton1_Click()
strpath = ThisWorkbook.Path
Path = Left(strpath, InStrRev(strpath, "\") - 1)
file = ThisWorkbook.Name
Filename = Left(file, InStrRev(file, ".") - 1)
strPathName = Path & "\" & Filename & ".txt"
strSheetName = ActiveSheet.Name
For n1 = 1 To 200
If Cells(12, n1).Interior.ColorIndex <> -4142 Then
col = col + 1
End If
Next n1
With Application '엑셀에서
.ScreenUpdating = False '화면 업데이트 (일시)정지
.Calculation = xlCalculationManual '셀계산 수동으로 전환
End With
Dim objStream As Object '오브젝트를 선언
Set objStream = CreateObject("ADODB.Stream") '오브젝트 생성
objStream.Open '열기!!
objStream.Position = 0 '쓰기 위치
objStream.Charset = "euc-kr" '캐릭터셋 설정
ClientPath = Left(strpath, InStrRev(strpath, "\") - 1)
aa = "TortoiseProc.exe /command:update /path:"
aa = aa + """" + ClientPath + """" + " /closeonend:2"
Shell (aa)
strFile2 = "EffectTable.xlsm"
Dim rngB As Workbook
Dim bName As String
bName = strFile2
For Each rngB In Workbooks
If rngB.Name = bName Then
MsgBox bName & "문서가 열려있군요!" & Chr(10) & Chr(10) & "닫겠슴니당"
Workbooks(bName).Close savechanges:=False '파일을 닫고
End If
Next rngB
Workbooks.Open Filename:=strpath & "\EffectTable.xlsm"
Windows("SkillTable.xlsm").Activate
For n1 = 1 To col - 1 '해당하는 칼럼번호 저장
If Cells(13, n1).Value = "DirectorKey" Then
DirectorKey = n1
ElseIf Cells(13, n1).Value = "ActionDirectorKey" Then
ActionDirectorKey = n1
ElseIf Cells(13, n1).Value = "GetHitDirectorKey" Then
GetHitDirectorKey = n1
ElseIf Cells(13, n1).Value = "GetHitObjectEffect" Then
GetHitObjectEffect = n1
End If
Next n1
For n = 15 To WorksheetFunction.CountA(Worksheets(strSheetName).Columns(1))
For xx = 13 To Workbooks("EffectTable.xlsm").Sheets("이펙트").Cells(1, 10)
If Cells(n, 1).Value = Workbooks("EffectTable.xlsm").Sheets("이펙트").Cells(xx, 1) Then
'인덱스가 같은걸 확인
Cells(n, DirectorKey).Value = Workbooks("EffectTable.xlsm").Sheets("이펙트").Cells(xx, 2)
Cells(n, ActionDirectorKey).Value = Workbooks("EffectTable.xlsm").Sheets("이펙트").Cells(xx, 3)
Cells(n, GetHitDirectorKey).Value = Workbooks("EffectTable.xlsm").Sheets("이펙트").Cells(xx, 4)
Cells(n, GetHitObjectEffect).Value = Workbooks("EffectTable.xlsm").Sheets("이펙트").Cells(xx, 5)
Exit For
End If
Next xx
Next n
For n = 1 To WorksheetFunction.CountA(Worksheets(strSheetName).Columns(1))
For n1 = 1 To col - 1
If Cells(n, n1).Value <> "" Then
If Cells(n, n1).Value = "True" Then
Text = Text & "TRUE" & vbTab
ElseIf Cells(n, n1).Value = "False" Then
Text = Text & "FALSE" & vbTab
Else: Text = Text & Cells(n, n1).Value & vbTab
End If
Else: Text = Text & vbTab
End If
Next n1
objStream.WriteText Text & vbCrLf
Text = ""
Next n
objStream.SaveToFile strPathName, 2 'strPathName 에 파일 위치와 파일명이 있어야함
objStream.Close '닫기
With Application '엑셀에서
.Calculation = xlCalculationAutomatic '셀계산 자동으로 전환
.ScreenUpdating = True
End With
For Each rngB In Workbooks
If rngB.Name = bName Then
Workbooks(bName).Close savechanges:=False '파일을 닫고
End If
Next rngB
MsgBox "TXT 저장완료"
End Sub