달력

12025  이전 다음

  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 31

[메크로]레이아웃 컨트롤

excel 2008. 8. 6. 21:14

Sub changeFile()
    For i = 8 To ActiveWorkbook.Sheets.Count
        Worksheets(i).Select
        changeSheet (i)
    Next i
   
    'makeIndex
    deleteHeader
End Sub

Sub makeIndex()
    Worksheets(2).Select
   
    For i = ActiveWorkbook.Sheets.Count To 4 Step -1
        Rows("2:2").Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
       
        Range("F3").Activate
        ActiveCell.FormulaR1C1 = Worksheets(i).Name
    Next i
End Sub

Sub changeSheet(idx As Integer)
   
    '레이아웃 편집
    Rows("1:2").Select
    With Selection
        .MergeCells = False
    End With
    Columns("A:A").Select
    Range("A2").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("B:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("F:F").Select
    Range("F3").Activate
    Selection.Insert Shift:=xlToRight
    Columns("I:J").Select
    Range("I3").Activate
    Selection.Insert Shift:=xlToRight
    Columns("M:Q").Select
    Selection.Insert Shift:=xlToRight
    Columns("M:Q").Select
    Selection.ColumnWidth = 2.3
    Range("B3").Select
    '속성정보 편집
    Columns("G:G").Select
    Range("G5").Activate
    Selection.Replace What:="X", Replacement:="C", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="9", Replacement:="N", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("B:C").Select
    Selection.ColumnWidth = 3
    Columns("E:E").Select
    Selection.Copy
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:A").Select
    Selection.ColumnWidth = 3
    Columns("B:C").Select
    Selection.ColumnWidth = 6
    Columns("D:E").Select
    Selection.ColumnWidth = 20
    Columns("F:K").Select
    Selection.ColumnWidth = 3
    Columns("L:L").Select
    Selection.ColumnWidth = 35
    Columns("R:R").Select
    Selection.ColumnWidth = 15
   
    '비고필드 자동줄바꿈
    Columns("R:R").Select
    Range("R2").Activate
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
   
    '첫번째시트에서 타이틀 카피
    Worksheets(1).Select
    Rows("1:7").Select
    Range("A7").Activate
    Selection.Copy
    Worksheets(idx).Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    '타이틀 편집
    Range("E2:H2").Activate
    ActiveCell.FormulaR1C1 = "재무"
    Range("E3:H3").Activate
    ActiveCell.FormulaR1C1 = ""
    Range("A9").Select
    Selection.Copy
    Range("A9").Select
    Range("E4:H4").Select
    ActiveSheet.Paste
    Range("L4").Select
    ActiveCell.FormulaR1C1 = ""
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "재무"
    Range("R3").Select
    ActiveCell.FormulaR1C1 = ""
    Range("R4").Select
    ActiveCell.FormulaR1C1 = Worksheets(idx).Name
    Rows("8:10").Select
    Selection.Delete Shift:=xlToUp
   
    Columns("A:A").Select
    Range("A1").Activate
    With Selection.Font
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
    End With
    ActiveWindow.Zoom = 85
   
End Sub

Sub deleteHeader()
    For i = 8 To ActiveWorkbook.Sheets.Count
        Worksheets(i).Select
        Rows("8:21").Select
        Selection.Delete Shift:=xlToUp
       
        Range("A8").Select
        ActiveCell.FormulaR1C1 = "1"
    Next i
End Sub

Sub copyValue()
'값만 copy
    Range("A600").Activate
     Cells.Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    Range("s1").Select
End Sub


Sub copyValueSheet()
    For i = 8 To ActiveWorkbook.Sheets.Count
        Worksheets(i).Select
        copyValue
    Next i
End Sub

Sub all()
    For i = 8 To ActiveWorkbook.Sheets.Count
        Worksheets(i).Select
        copyValue
        editForm
    Next i
End Sub

Sub editSheet()
    For i = 8 To ActiveWorkbook.Sheets.Count
        Worksheets(i).Select
        editForm
    Next i
End Sub


Sub editForm()
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("s:S").Select
    Selection.Delete Shift:=xlToLeft
    rowNumbering
End Sub

Sub rowNumbering()
'마지막 row까지
    For i = 8 To Range("A8").End(xlDown).Row
        Range("A" & i).Activate
        ActiveCell.FormulaR1C1 = i - 7
    Next i
End Sub

'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

시트 카피
Sheets("B200003").Select
Sheets("B200003").Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = "B200004"
시트명 변경
Sheets("B200003").Name = "ABC"

'excel' 카테고리의 다른 글

[함수]문자열자르기 - SEARCH  (0) 2008.11.11
[함수]중복된 목록에서 데이터 불러오기  (0) 2008.10.02
[함수]파일 및 시트명  (0) 2008.09.30
[함수]엑셀함수  (0) 2008.09.30
[함수]indirect - 문자열을 참조로 사용할 때  (0) 2008.09.25
Posted by marryjane
|

티스토리툴바