SourceCode ,Software & Life

'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