'목록하단 광고 치환자(withSeok)
유튜브 채널

http://bit.ly/위드석 

 

 

출처 : 링크

엑셀 파일 다운로드

가계부 컬러입히기.xlsm
0.02MB

 

Sub Jo_Color()
Dim rD As Range
Dim rE As Range
Dim i As Long
Dim vT, sT As String
Dim jList As Object

Set rD = Range("b2").CurrentRegion
Set jList = CreateObject("system.collections.arraylist")
For Each rE In rD.Columns(2).Cells
    sT = rE.Value
    If Not jList.contains(sT) Then jList.Add sT
Next rE
With CreateObject("scripting.dictionary")
    For Each rE In rD.Rows
        For i = 0 To jList.Count - 1
            If jList(i) = rE.Cells(2) Then
                If Not .exists(jList(i)) Then
                    .Item(jList(i)) = rE.Cells(2).Interior.Color 'Index
                End If
                rE.Interior.Color = .Item(rE.Cells(2).Value)
            End If
        Next i
    Next rE
End With
End Sub

 

 

 

728x90

+ Recent posts