VB(A)

기간에 맞춰서 셀에 색 입히기

당근쨈 2016. 10. 26. 16:29

http://cafe.naver.com/excelmaster/131563



Option Base 1
Option Explicit
Sub Macro()
 
    Dim wsData As Worksheet
    Dim wsChart As Worksheet
    Dim Data As Range
    Dim Tmp As Range
    Dim rngPaste As Range
    Dim i As Long
    Dim CellsColor() As Long
    Dim DataCount As Long
    
    ' 변수설정 구간
    Set wsData = Sheets(1)
    Set wsChart = Sheets(2)
    
    ' 기존자료를 초기화 후에 데이터 붙여넣기 셀 선언
    With wsChart.Range("A3")
        .CurrentRegion.Offset(2).Clear
        Set rngPaste = .Cells
    End With
    
    ' 데이터영역을 변수에 담습니다.
    With wsData.Range("A1").CurrentRegion
        Set Data = .Offset(1).Resize(.Rows.Count - 1)
    End With
    
    '데이터영역의 Row 수를 파악하고 그만큼 CellsColor배열을 재선언합니다.
    DataCount = Data.Rows.Count
    ReDim CellsColor(DataCount)
    
    '서비스기간 행에 있는 셀의 색번호를 배열에 담습니다.
    For Each Tmp In Data.Columns(2).Cells
        i = i + 1
        CellsColor(i) = Tmp.Interior.Color
    Next Tmp
    
    '출력 시트에 데이터를 출력합니다.
    '고객명, 파견근로자를 차례대로 출력한 후에
    '서비스기간만큼 셀영역을 잡아서 색깔에 맞게 셀에 색을 입혀줍니다.
    For i = 1 To DataCount
        With rngPaste
            .Value = Data(i, 1)
            .Offset(, 1= Data(i, 3)
            .Offset(, 2= Data(i, 4)
            
             wsChart.Range(.Offset(, Split(Split(Data(i, 2), "-")(0), ".")(1)), _
                            .Offset(, Split(Split(Data(i, 2), "-")(1), ".")(1))).Offset(, 2).Interior.Color = CellsColor(i)
            
            Set rngPaste = .Offset(1)
        End With
    Next i
    
    '출력 시트의 셀서식을 정해줍니다.
    '선을 넣고 텍스트는 가운데정렬을 합니다.
    With wsChart.Range("A1").CurrentRegion
        With .Offset(1).Resize(.Rows.Count - 1)
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlCenter
        End With
    End With
    
End Sub
 
cs



통합 문서1.xlsm