본문 바로가기
관심종목/about PCs

VBA (엑셀 매크로) : 참조할 엑셀파일을 DB화 한 후 중복 값 찾아 표시

by 신의손길 2011. 12. 22.

친구와 완성한 엑셀 매크로.

둘다 VBA가 익숙한 것이 아니라 코드의 최적화는 다소 미흡함.

기록을 위해 남겨둠.

기능 설명 : 대조문서, 적용문서로 구분하여 적용문서에서 매크로 실행시 대조문서의 일정 열을 읽어와서
                적용문서의 일정열과 비교하여 동일 값일시 배경색을 변경함

* 다량의 값을 빠른시간내에 처리하기 위해 DB를 사용함

Sub Find_Disposition()
    Dim varFilepath As Variant
    Dim strSheetname As String
    Dim strSQL As String
    Dim dbMyDB As DAO.Database
    Dim rstRST As Recordset
    Dim rngAll As Range

    Set rngAll = Sheet1.Range("$D:$D") '표시할 곳을 적용문서의 첫번째시트 - D열로 설정
    varFilepath = Application.GetOpenFilename(FileFilter:="엑셀파일(*.xls;*.xlsx),*.xls;*.xlsx", Title:="대조문서 파일 선택", MultiSelect:="False")
    If varFilepath = "False" Then '불러올 파일선택 취소시 매크로 종료
        MsgBox "파일을 선택하지 않았습니다"
        Exit Sub
    End If

    '참조문서의 시트 이름을 변수화 하기
    Workbooks.Open (varFilepath)
    strSheetname = ActiveSheet.Name
    ActiveWorkbook.Close False

    '중복값 제거 SQL문
    strSQL = "Select DISTINCT 문서첫째열구분값 FROM [" & strSheetname & "$]"
    Set dbMyDB = OpenDatabase(varFilepath, False, True, "excel 8.0;")
    Set rstRST = dbMyDB.OpenRecordset(strSQL)

    Do Until rstRST.EOF
        Debug.Print rstRST!문서첫째열구분값
        Set c = rngAll.Find(rstRST!문서첫째열구분값, LookAt:=xlWhole)
        If Not c Is Nothing Then
            c.Interior.ColorIndex = 8
            firstaddress = c.Offset
            Do
                Set c = rngAll.FindNext(c)
                c.Interior.ColorIndex = 8
            Loop While Not c Is Nothing And c.Offset <> firstaddress
        End If

        rstRST.MoveNext

    Loop

    Debug.Print rstRST.RecordCount
    rstRST.Close
    Application.ScreenUpdating = False
End Sub

#사족

IE에서는 코드가 한줄씩 다 띄워쓰기가 되버린다.. Code Highlighter 치환자에 <p> </p>를 \n 으로 처리하니, 크롬에서는

잘 나오는데 IE에서는 제대로 처리가 안된다. </p> 를 공백처리 하면 IE 에서는 잘 나오는데, 크롬에선 주루룩 붙어버리고...

실력부족으로 크로스 브라우징 해결책을 찾지못하고, 크롬에 맞춰놓았슴.

Syntaxhighlighter 사용포기...ㅡ_-);;