'formula xls 에서 문서ID, SEQ 와 MSGID, SEQ 를 가져와 LIST 로 만드는 함수
'파일다이얼로그창에서 적용할 파일을 선택해서 동작시킨다.
Sub xlsSeq()
Dim Files As Variant
Dim fileX As Variant
Dim wb As Workbook
Dim xlsSheet As Worksheet
Dim listSheet As Worksheet
Set listSheet = Worksheets("ID_SEQ_LIST_B3")
Files = Application.GetOpenFilename(filefilter:="total Files(*.*),*.*", Title:="파일선택", MultiSelect:=True)
For Each fileX In Files
Set wb = Workbooks.Open(fileX)
For m = 8 To wb.Sheets.Count
Set xlsSheet = wb.Worksheets(m)
Call getXlsSEQ(xlsSheet, listSheet)
Next m
'파일 저장후 close
wb.Save
wb.Close
Next fileX
End Sub
Private Sub getXlsSEQ(xlsWs As Worksheet, listWs As Worksheet)
Dim xlsID As String
Dim msgID As String
Dim listLastRow, xlsLastRow As Integer
xlsLastRow = xlsWs.Range("A65535").End(xlUp).Row
If Not (IsError(xlsWs.Range("P2").Value)) Then
xlsID = xlsWs.Range("P2").Value
msgID = xlsWs.Range("P4").Value
'마지막 row까지
For i = 8 To xlsLastRow
listLastRow = listWs.Range("A65535").End(xlUp).Row + 1
listWs.Cells(listLastRow, 1).Value = msgID
listWs.Cells(listLastRow, 2).Value = xlsWs.Range("A" & i).Value
listWs.Cells(listLastRow, 3).Value = xlsID
listWs.Cells(listLastRow, 4).Value = xlsWs.Range("B" & i).Value
Next i
End If
End Sub
Sub editFormatIoCls()
Dim Files As Variant
Dim fileX As Variant
Dim wb As Workbook
Files = Application.GetOpenFilename(filefilter:="total Files(*.*),*.*", Title:="파일선택", MultiSelect:=True)
For Each fileX In Files
Set wb = Workbooks.Open(fileX)
For m = 8 To wb.Sheets.Count
wb.Worksheets(m).Select
wb.Worksheets(m).Columns("M:M").Select
Selection.Copy
'copy 한 columns 를 붙여넣기
wb.Worksheets(m).Columns("T:T").Select
Selection.Insert Shift:=xlToRight
wb.Worksheets(m).Columns("M:M").Select
Selection.Delete Shift:=xlToLeft
wb.Worksheets(m).Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight
Next m
wb.Save
wb.Close
Next fileX
End Sub
Sub addFormula()
Dim Files As Variant
Dim fileX As Variant
Dim wb As Workbook
Files = Application.GetOpenFilename(filefilter:="total Files(*.*),*.*", Title:="파일선택", MultiSelect:=True)
For Each fileX In Files
Set wb = Workbooks.Open(fileX)
For m = 8 To wb.Worksheets.Count
wb.Worksheets(m).Select
wb.Worksheets(m).Range("P2").Formula = "=VLOOKUP(P4, [000.0.macro.xls]ID_SEQ_LIST_B3!$E:$F, 2, FALSE)"
Call addFormulaXlsSEQ(wb.Worksheets(m))
Next m
wb.Save
wb.Close
Next fileX
End Sub
Sub addFormulaXlsSEQ(xlsWs As Worksheet)
Dim xlsLastRow As Integer
If Not (IsError(xlsWs.Range("P2").Value)) Then
With xlsWs
xlsLastRow = Range("A65535").End(xlUp).Row
Columns("E:E").Select
Selection.Copy
Selection.Insert Shift:=xlToRight
Columns("E:E").Select
Selection.Replace What:="_", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B8").Select
Application.CutCopyMode = False
'셀에 수식넣기
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[3],C30:C31, 2, FALSE)"
'Range 에 수식을 AutoFill
If xlsLastRow > 8 Then
Selection.AutoFill Destination:=Range("B8:B" & xlsLastRow)
End If
Range("B8:B" & xlsLastRow).Select
Selection.Copy
Range("B8").Select
'copy 한 selection 을 선택붙여넣기로 값만 넣기
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
'Find 로 문자열 #N/A 를 찾아 "" 로 replace 하기
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
End With
Else
xlsWs.Range("A8").Select
End If
End Sub
'시트명 (msgid) 변경
Sub changeSheetsName()
Dim Files As Variant
Dim fileX As Variant
Dim wb As Workbook
Files = Application.GetOpenFilename(filefilter:="total Files(*.*),*.*", Title:="파일선택", MultiSelect:=True)
For Each fileX In Files
Set wb = Workbooks.Open(fileX)
Call changeSheetName(wb)
Call changeMsgId(wb)
wb.Save
wb.Close
Next fileX
End Sub
Private Sub changeSheetName(wb As Workbook)
For i = 1 To wb.Worksheets.Count
If i < 8 Then
If i = 1 Or i = 6 Or i = 7 Then
With wb.Worksheets(i)
.Select
Columns("F:F").Select
Selection.Replace What:="B30", Replacement:="B3", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
End If
Else
wb.Worksheets(i).Name = Left(wb.Worksheets(i).Name, 2) & Right(wb.Worksheets(i).Name, 4)
End If
Next i
End Sub
Private Sub changeMsgId(wb As Workbook)
For i = 8 To wb.Worksheets.Count
With wb.Worksheets(i)
.Select
'Formula 와 FormulaR1C1 의 차이점. Formula 로 수식을 넣을 때, 따옴표처리는 Chr(34)
Range("P4").Formula = "=REPLACE(CELL(" & Chr(34) & "filename" & Chr(34) & ",A1),1,FIND(" & Chr(34) & "]" & Chr(34) & ",CELL(" & Chr(34) & "filename" & Chr(34) & ",A1))," & Chr(34) & "" & Chr(34) & ")"
End With
Next i
End Sub