VB(A)

두 시트의 내용을 한 시트로 합치기

당근쨈 2015. 3. 9. 14:30

간단하다.

두 시트의 내용을 한 시트로 합치는 내용으로 Find, Cut, Copy 로 금방 해결가능하다.

어떤 방식을 써볼까.. 고민하다가 그냥 무식하게 밀고 나감.


Option Explicit
 
Sub getData()
 
    Dim wsAll As Worksheet, wsList As Worksheet, wsData As Worksheet
    Dim dataList As Range, dataTable As Range, rngPaste As Range
    Dim rngCell As Range, rngData As Range
    Dim intR As Integer
    Dim i As Integer
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    '워크시트, 상세항목 테이블 정의
    Set wsAll = Sheets("절단내역")
    Set wsList = Sheets("발급대장")
    Set wsData = Sheets("상세항목")
    Set rngPaste = wsAll.Range("A5")
    Set dataList = Range(wsList.Range("A6"), wsList.Cells(Rows.Count, "A").End(xlUp))
    Set dataTable = Range(wsData.Range("A4"), wsData.Cells(Rows.Count, "K").End(xlUp))
    intR = dataTable.Rows.Count
    Set rngData = rngPaste.Resize(intR)
    
    '절단내역 시트 기존항목 삭제
    Range(rngPaste, wsAll.Cells(Rows.Count, "S")).Clear
    
    '상세항목 데이터를 값만 가져와서 제목에 맞게 이동
    dataTable.Copy
    rngPaste.PasteSpecial Paste:=xlPasteValues
    With rngPaste
        .Offset(, 2).Resize(intR, 2).Cut .Offset(, 12)
        .Offset(, 4).Resize(intR, 2).Cut .Offset(, 15)
        .Offset(, 6).Resize(intR, 2).Cut .Offset(, 17)
        .Offset(, 9).Resize(intR, 2).Cut .Offset(, 2)
    End With
        
    '발급대장에서 발급번호 일치하는 내용 가져오기
    i = 1
    For Each rngCell In rngData
        If rngCell = rngCell.Offset(1Then
            i = i + 1
        Else
            dataList.Find(what:=rngCell, lookat:=xlWhole).Offset(, 2).Resize(, 8).Copy rngCell.Offset(1 - i, 4).Resize(i)
            i = 1
        End If
    Next rngCell
    
    '서식 지정
    With rngData.Resize(, 19)
        .Font.Size = 10
        .HorizontalAlignment = xlCenter
        .Columns(17).NumberFormatLocal = "yy""-""m""-""d;@"
        .Borders.LineStyle = xlNone
    End With
    
    rngPaste.Select
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
 
End Sub
cs