Excel & VBA---Brain Training

문자열정보를 읽어서 조건부서식, 사용자정의함수를 활용한다

그림과 같이 어떤 온라인유통회사에서 고객관리명단이 있고
불량고객명단이 있다
문제는 고객관리명단상에 불량고객명단의 주소의 일부가 들어있으면
조건부서식을 하여 배송부서에서 배송여부를 판단하게 하려고 한다



물론
불량고객명단은 전화번호,이메일,이름등도 있지만 이것은 별문제가 없는 것이고
주소는 주소1,주소2로 구분되기도 하고 하여 주소중 일부에 이것이
들어있는지 확인하여야 할 상황이다, 이것이 문제인것이다

아래 코드를 복사하여 붙여 넣고 실행하면
위의 그림의 두개의 시트가 만들어진다
각자 수단과 방법을 가리지 말고 풀어 보시기 바란다
아래의 코드는 일부러 코딩의 내공을 위하여 복잡하게 GoTo문을
넣어서 작성하였으니 연구해 보시고

Sub creatDummyDatas4BrainTraing()
Const ALPHAS_NUMS As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
Const SHT_BAD_CUS As String = "BadCustomers"
Const SHT_CUS As String = "Customers"
Dim rX As Range
Dim iX As Integer
Dim sPart As String
Dim sTemp As String
Dim sWorkCode As String
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(SHT_BAD_CUS).Delete
Worksheets(SHT_CUS).Delete
Application.DisplayAlerts = True

sWorkCode = "first"
Randomize

With Worksheets.Add
    .Name = SHT_BAD_CUS
    .Range("A1") = "불량고객주소일부"
    For Each rX In .Range("A2").Resize(20).Cells
		Do
            GoTo PART_WORK
FIRST:
        Loop While Application.CountIf(.Range("A1").CurrentRegion, sPart) > 0
        rX = sPart
        
    Next
    .Range("B1") = "불량고객전체주소"
    .UsedRange.Columns.AutoFit
End With
sWorkCode = "second"
With Worksheets.Add
    .Name = SHT_CUS
    Range("A1") = "고객주소전체"
    For Each rX In Range("A2").Resize(300).Cells
        For iX = 1 To Int(Rnd() * 5) + 3
            GoTo PART_WORK
SECOND:
            sTemp = sTemp & sPart
        Next
        rX = sTemp
        sTemp = ""
    Next
    .UsedRange.Columns.AutoFit
End With
Exit Sub

PART_WORK:
If sWorkCode = "first" Then
    Do ' 숫자만 나오면 다시 작업
    sPart = Mid(ALPHAS_NUMS, Int(Rnd() * Len(ALPHAS_NUMS) - 5) + 1, Int(Rnd() * 5) + 7)
    Loop While IsNumeric(sPart)
    GoTo FIRST
Else
    sPart = Mid(ALPHAS_NUMS, Int(Rnd() * Len(ALPHAS_NUMS) - 5) + 1, Int(Rnd() * 3) + 3)
    GoTo SECOND
End If
End Sub

위와 같은 문제를 당초 문제를 제시하였던 분은 아래와 같이 풀었다
물론 VBA없이 작업을 한 내용을 VBA로 실행하여 그대로 복기 시키는 코드이니
실행 시켜 보시기 바란다

Sub creatDummyDatas4BrainTraingWithFormula()
Const ALPHAS_NUMS As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
Const SHT_BAD_CUS As String = "BadCustomers"
Const SHT_CUS As String = "Customers"
Dim rX As Range
Dim iX As Integer
Dim sPart As String
Dim sTemp As String
Dim sWorkCode As String
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(SHT_BAD_CUS).Delete
Worksheets(SHT_CUS).Delete
Application.DisplayAlerts = True

sWorkCode = "first"
Randomize

With Worksheets.Add
    .Name = SHT_BAD_CUS
    .Range("A1") = "불량고객주소일부"
    For Each rX In .Range("A2").Resize(20).Cells
    
        Do ' 중복되는 것 다시 콜
            GoTo PART_WORK
FIRST:
        Loop While Application.CountIf(.Range("A1").CurrentRegion, sPart) > 0
        rX = sPart
        
    Next
    .Range("B1") = "불량고객전체주소"
    .UsedRange.Columns.AutoFit
End With
sWorkCode = "second"
With Worksheets.Add
    .Name = SHT_CUS
    Range("A1") = "고객주소전체"
    For Each rX In Range("A2").Resize(300).Cells
        For iX = 1 To Int(Rnd() * 5) + 3
            GoTo PART_WORK
SECOND:
            sTemp = sTemp & sPart
        Next
        rX = sTemp
        sTemp = ""
    Next
    .UsedRange.Columns.AutoFit
End With


' 아래 부분이 메뉴얼로 위의 문제를 푼 작업한 내용이다
With Worksheets(SHT_BAD_CUS)
    .Activate
    MsgBox "조건부서식을 위하여 수식을 사용한 중간 열을 하나 만든다"
    With .Range("A1").CurrentRegion.Offset(, 1).SpecialCells(xlCellTypeBlanks)
        .Formula = "=INDEX(" & SHT_CUS & "!A:A,MATCH(""*""&A2&""*""," & SHT_CUS & "!A:A,0),1)"
        MsgBox "조건부서식에서 다른 시트를 참조하지 못합니다, 방법은 이름을 지어서" & vbNewLine & _
            "참조합니다, 그래서 참조할 이름을 하나 만듭니다"
        ThisWorkbook.Names.Add "badAdd", .Cells 
    End With
End With

With Worksheets(SHT_CUS)
    .Activate
    MsgBox "수식열을 활용하여 조건부서식합니다"
    With .Range("A1").CurrentRegion.Offset(1).Resize(.Range("A1").CurrentRegion.Rows.Count - 1)
        Dim oFormat As FormatCondition
        Set oFormat = .FormatConditions.Add(Type:=xlExpression, Formula1:="=COUNTIF(badadd,A2)>0")
        With oFormat
            .Interior.ColorIndex = 6
            .Font.Bold = True
        End With
    End With
    MsgBox "불량주소가 서식된 내용을 살펴보세요"
End With

Exit Sub
PART_WORK:
If sWorkCode = "first" Then
    Do ' 숫자만 나오면 다시 작업
    sPart = Mid(ALPHAS_NUMS, Int(Rnd() * Len(ALPHAS_NUMS) - 5) + 1, Int(Rnd() * 5) + 7)
    Loop While IsNumeric(sPart)
    GoTo FIRST
Else
    sPart = Mid(ALPHAS_NUMS, Int(Rnd() * Len(ALPHAS_NUMS) - 5) + 1, Int(Rnd() * 3) + 3)
    GoTo SECOND
End If
If sWorkCode = "first" Then
    GoTo FIRST
Else
    GoTo SECOND
End If
End Sub

이제 최종 문제는
위에서 만든 수식열을 만들지 않고
사용자정의 함수를 조건부서식에서 참조하여 조건부서식을 하는 내용이다
위에서 메뉴얼로 푼 내용을 VBA의 함수로 적절히 바꿔보시는 것이
문제이다..
아래의 화일내용을 보세요!!

• 01