'업무 능력 향상/엑셀 VBA 활용'에 해당되는 글 113건

전화번호 정리하는 VBA

엑셀에 있는 여러가지 전화번호 리스트를 보면 숫자로만 되어 있는 경우도 있고, 032)354-2568 처럼 되어 있는 경우도 있고 051-2345-9857 처럼 되어 있는 경우도 있다.

휴대폰번호를 포함하여 전부 다시 정렬하고 싶을 때 사용하려고 작성해봤다.

VBA는 엑셀함수와는 달리 약간의 코딩으로 원하는 결과를 매우 편하게 얻을 수 있다. 도움이 되겠다 싶은 것을 하나 하나 정리해두면 나중에 일을 편하게 할 수 있을 것 같다.

• Sub 전화번호정렬()

      Dim strU As String      '// 문자를 합쳐갈 변수

      Dim i As Integer        '// 전체 문자길이 만큼 반복할 변수

      Dim rngC As Range       '// 각 Line 변수

      Dim rngAll As Range     '// 전체 범위 지정

      

      Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지

      Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))   '// A2 셀부터 A열의 마지막 셀까지

          

      For Each rngC In rngAll

          For i = 1 To Len(rngC)                      '// 전체 문자길이 만큼 반복

                  If IsNumeric(Mid(rngC, i, 1)) Then  '// 문자열이 숫자일 경우

                      strU = strU & Mid(rngC, i, 1)   '// 각 숫자를 합쳐감

                  End If

          Next i

        

          Select Case Len(strU)     '// IF 문에서 숫자만 추출된 strU 의 길이 검사

              Case 8      '// 전국대표번호 처럼 8자리로 된 경우

                  rngC.Offset(0, 1) = Format(strU, "0000-0000")

              Case 9

                  rngC.Offset(0, 1) = Format(strU, "00-000-0000")

              Case 10

                  If Left(strU, 2) = "02" Then

                      rngC.Offset(0, 1) = Format(strU, "00-0000-0000")

                  Else

                      rngC.Offset(0, 1) = Format(strU, "000-000-0000")

                  End If

              Case 11

                  rngC.Offset(0, 1) = Format(strU, "000-0000-0000")

          End Select

          

          strU = ""   '// 값을 기록했으니까 초기화가 필요함

      Next rngC

      

      Set rngAll = Nothing  '// 변수 초기화

      MsgBox "정리완료"

  
  

  End Sub

외부 엑셀파일에서 자료를 가져오는 방법이다.

서식까지 그대로 가져오는 방법과 SQL 을 이용하여 가져오는 방법이다.

A1 셀에서 값을 a, b 로 다르게 적어주면 가져오는 파일의 내용이 달라진다.

Excel_Get.zip

Sub ExcelFile_Get()
    Dim getFile As Object
    Dim FilePath As String          '// 파일 경로 변수
    Dim FileName As String         '// 가져올 엑셀 파일명 변수
   
    On Error Resume Next
    FilePath = ThisWorkbook.Path + "\"  '// 현재 파일 경로
   
    If [A1].Text = "a" Then
        FileName = "Asample.xlsx"      '// 다른 엑셀파일
    ElseIf [A1].Text = "b" Then
        FileName = "Bsample.xlsx"      '// 다른 엑셀파일
    Else
        MsgBox " 가져올 파일을 선택하지 않았습니다"
        Exit Sub
    End If
   
    Set getFile = GetObject(FilePath & FileName)
    With ActiveWorkbook.ActiveSheet.Range("A5")    '// A5열부터 데이터 출력
        .CurrentRegion.Clear    '// 현재 존재하는 값을 전부 삭제
        getFile.Sheets([A2].Text).UsedRange.Copy [A5]
        getFile.Close False
    End With
    Set getFile = Nothing
End Sub

또다른 방법은 데이터베이스처럼 가져오는 방법이다.

이 경우에는 서식유지까지는 안된다.

Sub ExcelFileData_Get()
'// This sub will pull data from an external .xlsx file.
'// The ADO 6.0 object library reference must be loaded.
    Dim conn As Object     '// 연결변수 선언
    Dim RS As Object
    Dim strSQL As String              '// SQL 문을 위한 변수
    Dim FilePath As String          '// 파일 경로 변수
    Dim FileName As String         '// 가져올 엑셀 파일명 변수
    Dim i As Long
   
    FilePath = ThisWorkbook.Path + "\"  '// 현재 파일 경로
    If [A1].Text = "a" Then
        FileName = "Asample.xlsx"      '// 다른 엑셀파일
    ElseIf [A1].Text = "b" Then
        FileName = "Bsample.xlsx"      '// 다른 엑셀파일
    Else
'        FileName = ActiveWorkbook.Name      '// 같은 엑셀파일(현재 엑셀화면에 활성화된 파일)
        MsgBox " 가져올 데이터를 선택하지 않았습니다"
        Exit Sub
    End If
  
    Set RS = CreateObject("ADODB.Recordset")
    Set conn = CreateObject("ADODB.Connection")
   
    With conn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FilePath & FileName & ";" & _
            "Extended Properties=Excel 12.0;"
        .Open
    End With
   
    strSQL = "SELECT * FROM [Data$] "           '// 엑셀시트이면 뒤에 $ 를 붙인다. Data Sheet 가 존재해야 한다.
   
    Set RS = conn.Execute(strSQL)
   
    With ActiveWorkbook.ActiveSheet.Range("A5")    '// A5열부터 데이터 출력
        .CurrentRegion.Clear    '// 현재 존재하는 값을 전부 삭제
       
        For i = 0 To RS.Fields.Count - 1    '// 레코드셋 제목 전부 가져오기
            .Offset(0, i).Value = RS.Fields(i).Name
        Next i
       
        .Offset(1, 0).CopyFromRecordset RS
       
    End With
   
    RS.Close
    conn.Close
    Set RS = Nothing
    Set conn = Nothing
   
End Sub

인도영화 자막은 하이픈 처리가 제대로 안된 것이 많다.

오랫만에 자막 좀 뒤져보다가 인도영화 자막 하이픈 처리한다고 엑셀로 수작업 처리했던 것이 있어서 VBA로 코드를 만들어봤다.

영화자막 하이픈수정처리.xlsm

Sub 자막하이픈수정()
    Dim rngC As Range
    Dim rngAll As Range
    Dim n As Long
   
    Set rngAll = Range([B2], Cells(Rows.Count, "B").End(3))
    Columns("B:C").NumberFormat = "@"     '// 텍스트 서식 지정
    If Cells(Rows.Count, "B").End(3).Row = 1 Then
        MsgBox "수정할 자막이 없습니다"
        Exit Sub
    End If
    rngAll.Offset(0, 1).ClearContents
    For Each rngC In rngAll
        If InStr(rngC, "<br>") Then
            If Not InStr(rngC, "-") And InStr(rngC.Offset(1, 0), "-") Then
                rngC.Offset(0, 1) = "- " & rngC
                rngC.Interior.ColorIndex = 36
                n = n + 1
            Else
                rngC.Offset(0, 1) = rngC
                rngC.Interior.ColorIndex = xlNone
            End If
        Else
            rngC.Offset(0, 1) = rngC
            rngC.Interior.ColorIndex = xlNone
        End If
    Next rngC
   
    Set rngAll = Nothing
    If n = 0 Then
        MsgBox "- 추가 대상이 없습니다"
    Else
        MsgBox n & "개 수정했습니다"
    End If
End Sub

Sub 결과비우기()
    Range([B2], Cells(Rows.Count, "B").End(3)).Offset(0, 1).ClearContents
End Sub

셀의 전체 구간이 아니라 부분 구간을 설정하고 그 구간에 중복되는 셀을 제거하는 VBA 코드를 만들어야 했다.

F8키를 눌러서 계속 검증 작업을 해보는데 문제가 생긴다.

확인결과 RemoveDuplicates 함수가 문제를 일으킨다.

이 함수는 머리글이 있고 전체에서 중복을 제거할 때 유용한가 보다.

중복제거를 제대로 못하는 경우도 있는 거 같아서 혹시나 하고 Sort 를 해서 중복을 제거하고 다시 원상태로 돌리는 작업을 진행했다.

그런데 전체구간의 중복을 체크하다보니 원하지 않는 셀이 중복이라고 삭제되는 경우가 생겨버렸다.

이걸 해결하려고 구간을 설정하고 반복해서 중복을 제거하라고 했던 것인데 잘 안되니까

생고생 끝에 다음 코드를 만들었다.

rngC 이 한행이 변하면서 구간내에서 6개의 셀을 다시 범위 설정해서 계속해서 반복적으로 돌려가면서 작업을 하는 것이다.

Sub 중복제거()
    Dim sTotal, eTotal As Long
    Dim i, n, k As Long
    Dim rngC, rngT As Range
    Dim rngAll As Range
    Dim rngDB As Range
   
    Application.ScreenUpdating = False      '// 화면 업데이트 (일시)정지
    sTotal = Cells(Rows.Count, "A").End(3).Row
    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))
    For Each rngC In rngAll
        Set rngDB = Range(rngC, rngC.Offset(5))
        For Each rngT In rngDB
             i = i + 1
            rngT.Offset(, 1) = i
        Next rngT
        Range(rngC, rngC.Offset(5, 1)).Sort key1:=rngDB, order1:=1, Header:=xlNo
        For n = rngC.Offset(5).Row To rngC.Row Step -1
            If Cells(n, 1) = Cells(n - 1, 1) Then
                Cells(n, 1).EntireRow.Delete
                k = k + 1
            End If
        Next n
        Range(rngC, rngC.Offset(5 - k, 1)).Sort key1:=Range(rngC.Offset(0, 1), rngC.Offset(5 - k, 1)), order1:=1, Header:=xlNo
        Range(rngC.Offset(, 1), rngC.Offset(, 1).End(4)).ClearContents
                     
        i = 0   '// 초기화
        k = 0   '// 초기화   

    Next rngC
   
    eTotal = Cells(Rows.Count, "A").End(3).Row
    MsgBox sTotal - eTotal & " 개 제거"

End Sub.

다른 시트 자료를 SQL 방식으로 가져오는 걸 지난번에 한번 해봤는데 네이버지식인에 올라온 문의사항을 보니 AutoFilter 를 이용하는 것보다 SQL 형태로 가져오면 좋겠다는 생각이 들어서 다시 한번 해봤다.

그러면서 SQL 조건에서 자료형식 체크하는 걸 추가했다.

내가 잘 몰라서인지 서식까지 그대로 복사를 하지 못했다.

Help_FileData.xlsm

Sub ExcelFileData_Get()
'// 외부 엑셀파일을 가져올 수도 있고 다른 시트 내용을 가져올 수도 있음
'// The ADO 6.0 object library reference must be loaded.
    Dim DBconn As ADODB.Connection      '// 연결변수 선언
    Dim RS As ADODB.Recordset
    Dim strSQL As String              '// SQL 문을 위한 변수
    Dim sht1 As Worksheet           '// 워크시트 변수
    Dim RSCount As Integer          '// 총 레코드(행)의 수 변수
    Dim FieldCount As Integer       '// 총 필드(열)의 수 변수
    Dim i, j, sRow As Integer
    Dim NoRecords As Boolean
    Dim FilePath As String          '// 파일 경로 변수
    Dim FileName As String         '// 가져올 엑셀 파일명 변수
    Dim a, b, c, d, S, T, U As String
       
    Set sht1 = Sheets("Main")      '// 현재 작업중인 워크시트 명
    Set DBconn = New ADODB.Connection
   
    FilePath = ThisWorkbook.Path + "\"  '// 현재 파일 경로
'    FileName = "Asample.xlsx"      '// 다른 엑셀파일명을 적어주고 주석을 제거하려면 아래 행은 주석처리 해야 함
    FileName = ActiveWorkbook.Name      '// 같은 엑셀파일(현재 엑셀화면에 활성화된 파일)
   
    S = sht1.Range("A3")      '// 업체코드
    T = sht1.Range("B3")      '// 업체명
    U = sht1.Range("C3")      '// 품목코드
    a = sht1.Range("D3")     '// 최종출고
    b = sht1.Range("E3")     '// 최종출고
    c = sht1.Range("F3")     '// 적용일자
    d = sht1.Range("G3")     '// 적용일자
    
    strSQL = "SELECT * FROM [Data$] "           '// 엑셀시트이면 뒤에 $ 를 붙인다. Data Sheet 가 존재해야 한다.
    If T <> vbNullString Then strSQL = strSQL & "Where 업체명=""" & T & """"         '// 업체명 필드 (텍스트 변수 처리)
    If S <> vbNullString Then
        If IsNumeric(S) = False Then
            MsgBox "업체코드는 숫자를 입력하셔야 합니다"
            Exit Sub
        Else
            strSQL = strSQL & " and 업체코드=" & S & ""        '// 업체코드 필드 (숫자 변수 처리)
        End If
    End If
    If U <> vbNullString Then
        If IsNumeric(S) = False Then
            MsgBox "품목코드는 숫자를 입력하셔야 합니다"
            Exit Sub
        Else
            strSQL = strSQL & " and 품목코드=" & U & ""        '// 품목코드 필드 (숫자 변수 처리)
        End If
    End If
   
    If a <> vbNullString And b <> vbNullString Then
        strSQL = strSQL & "And (최종출고일 Between #" & a & "# And #" & b & "#) "     '// 최종출고 a~b 일까지 (날짜변수 처리)
    ElseIf a <> vbNullString And b = vbNullString Then
        strSQL = strSQL & "And (최종출고 = #" & a & "#) "     '// 최종출고 a (날짜변수 처리)
    ElseIf a = vbNullString And b <> vbNullString Then
        strSQL = strSQL & "And (최종출고 = #" & b & "#) "     '// 최종출고 b (날짜변수 처리)
    End If
   
    If c <> vbNullString And d <> vbNullString Then
        strSQL = strSQL & "And (적용일자 Between #" & c & "# And #" & d & "#) "     '// 입고일자는 a~b 일까지 (날짜변수 처리)
    ElseIf c <> vbNullString And d = vbNullString Then
        strSQL = strSQL & "And (적용일자 = #" & c & "#) "     '// 입고일 a (날짜변수 처리)
    ElseIf c = vbNullString And d <> vbNullString Then
        strSQL = strSQL & "And (적용일자 = #" & d & "#) "     '// 입고일 a (날짜변수 처리)
    End If
'    strSQL = strSQL & "Order By 업체명"       '// 업체명 기준으로 오름차순 정렬
   
    With DBconn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FilePath & FileName & ";" & _
            "Extended Properties=Excel 12.0;"
        .Open
    End With

    Set RS = DBconn.Execute(strSQL)
   
    With ActiveWorkbook.ActiveSheet.Range("A5")    '// A5열부터 데이터 출력
        .CurrentRegion.Offset(1).ClearContents    '// 현재 존재하는 값을 전부 삭제      
       
        NoRecords = False
        With RS
            FieldCount = .Fields.Count      '// 전체 필드(제목열)의 개수
            For i = 0 To .Fields.Count - 1     '// 레코드셋 제목 전부 가져오기
                sht1.Cells(5, 1).Offset(, i) = .Fields(i).Name
            Next i

               sRow = Cells(Rows.Count, "A").End(3)(2).Row     '// 첫번째 값을 뿌릴 행의 값
           
            If Not (.BOF And .EOF) Then
                NoRecords = False
                .MoveFirst
                While Not .EOF
                    .MoveNext
                    RSCount = RSCount + 1   '// 전체 레코드수 구하기
                Wend        '// 주어진 조건이 True인 동안은 일련의 문을 계속 실행
            Else
                NoRecords = True
                MsgBox ("가져올 자료가 없음")
                Exit Sub
            End If
           
            .MoveFirst      '// 레코드의 처음으로 이동
            While Not .EOF      '// EOF 를 만나기 전까지 계속 반복하라
                For i = sRow To sRow + RSCount - 1 Step 1   '// 총 행의 수만큼 반복
                    For j = 1 To FieldCount Step 1      '// 총 열의 수만큼 반복
                        sht1.Cells(i, j) = .Fields(j - 1)        '// 셀에 값을 기록하라
                    Next j
                    .MoveNext   '// 다음 레코드(행)으로 이동
                Next i
            Wend
        End With
    End With
    RS.Close
    DBconn.Close
    Set RS = Nothing
    Set DBconn = Nothing
   
    MsgBox RSCount & "개 데이터 가져오기 완료"
End Sub

네이버지식인에 올라온 환율 파싱 질문을 보고 한번 시도를 해봤다.

파싱하는 것은 WaitForResponse 하는 부분까지를 알아내는 것과 그 뒤의 처리로 분류할 수가 있다.

난 아직 앞부분 처리하는 건 잘 모른다.

뒷부분 처리는 Instr함수, Split 함수, Replace 함수 그리고 debug.print 기능만 이용하면 원하는 걸 얼마든지 추출해 낼 수가 있다.

내가 뽑아내고 싶은 값이 무엇인지에 따라 해당되는 걸 다시 줄여서 Split 함수를 이용하여 원하는 구간을 줄여나간다.

가령 1,097.20 이란 값만 뽑아내고 싶다면 ....

직접실행창(Ctrl + G) 에 뿌려진 결과를 보고 일정한 규칙을 찾아내면 된다.

<td> 라는 걸 Split 한다고 하면 내가 원하는 <td>는 몇번째에 있는지 한번 보자.

4번째에 있다. Split 함수는 Split(T,"<td>")(0) 를 하면 <td>를 기준으로 (0)은 앞의 것을 반환한다.

뒤의 것을 반환하는 것은 <td>가 여러개가 존재하므로 (4) 를 해주어야 한다.

이제 Debug.Print T를 해보면 결과는 1,097.20</td> 를 화면에 출력해준다.

원하는 결과는 1,097.20 이므로 </td>의 앞부분이다. Split 함수 기준으로 앞부분은 (0) 이라고 했으므로

한번에 처리하는 Split 함수는 T = Split(Split(T, "<td>")(4), "</td>")(0) 가 된다.

얻어야 할 결과값이 4.70 이라면 ....

<td class="tx_l"><span class="down"><span>??/span> <span class="num">4.70</span></span></td>

에서 Replace 함수를 이용하여 제거해서 결과를 얻거나 범위를 좁혀서 Split 함수를 이용하면 된다.

환율데이터가져오기.xlsm

Sub 환율파싱()
    Dim T As String
    Dim C As Variant
    Dim R As Variant
    Dim n As Long

    Dim Winhttp As Object
    Set Winhttp = CreateObject("WinHttp.WinHttpRequest.5.1")

    With Winhttp
        .Open "GET", "http://search.naver.com/search.naver?sm=tab_hty.top&where=nexearch&ie=utf8&query=%ED%99%98%EC%9C%A8"
        .SetRequestHeader "Host", "www.NAVER.com"
        .Send
        .WaitForResponse

        T = StrConv(.ResponseBody, vbUnicode)
         .WaitForResponse
'        Debug.Print T
        T = Split(Split(T, Chr(60) + "em" + Chr(62) + "USD")(1), "last")(0)
'        Debug.Print T
        T = Split(T, "</th>")(1)
        T = Replace(T, "<strong class=""down"">", "")
        T = Replace(T, "</strong>", "")
        T = Replace(T, " class=""tx_l""", "")
        T = Replace(T, "<span class=""down""><span>??/span> <span class=""num"">", "")
        T = Replace(T, "<span class=""percent down"">", "")
        T = Replace(T, "</span>", "")
        T = Replace(T, "<td class=""", "")
        Debug.Print T
       
        With Range("B2:H2")
            .Value = Array("매매기준율", "전일대비", "등락율", "현찰살때", "현찰팔때", "송금보낼때", "송금받을때")
            .HorizontalAlignment = xlCenter
            .Interior.ColorIndex = 36
        End With
       
        R = Split(T, "<td>")
        For n = 1 To UBound(R)
            Cells(3, n + 1) = Split(R(n), "</td>")(0)
        Next n
    End With
    Columns("A:H").AutoFit
 End Sub

SQL 기능을 이용하여 원하는 데이터 가져오기

다른 파일이나 같은 파일내 다른 시트에서 자료를 데이터베이스처럼 가져오는 기능을 구현한 것이다.

외국자료를 참조하였고, 필요한 기능을 보강하고, 편의성을 중점적으로 보강한 거의 완벽에 가까운 자료이다.

Where 조건문을 포함할 수도 있고 포함하지 않을 수 있는 경우를 모두 고려하여 만들려고 하는데, 사과이름 변수는 꼭 포함해야만 동작이 된다. 좀 더 공부하면 이 부분도 해결할 수 있지 않을까?

등급, 입고일, 출하일 은 모두 빈공백으로 설정하면 Where 검색조건에서 제외되도록 했다.

FileData_Get.xlsm

Asample.xlsx

Sub ExcelFileData_Get()
'// This sub will pull data from an external .xlsx file.
'// The ADO 6.0 object library reference must be loaded.
    Dim conn As ADODB.Connection      '// 연결변수 선언
    Dim RS As ADODB.Recordset
    Dim strSQL As String              '// SQL 문을 위한 변수
    Dim sht1 As Worksheet           '// 워크시트 변수
    Dim RSCount As Integer          '// 총 레코드(행)의 수 변수 선언
    Dim FieldCount As Integer       '// 총 필드(열)의 수 변수 선언
    Dim i, j, sRow As Integer
    Dim NoRecords As Boolean
    Dim FilePath As String          '// 파일 경로 변수
    Dim FileName As String         '// 가져올 엑셀 파일명 변수
    Dim a, b, c, d, T, U As String
       
    Set sht1 = Sheets("Main")      '// 현재 작업중인 워크시트 명
    Set conn = New ADODB.Connection
   
    FilePath = ThisWorkbook.Path + "\"  '// 현재 파일 경로
'    FileName = "Asample.xlsx"      '// 다른 엑셀파일
    FileName = ActiveWorkbook.Name      '// 같은 엑셀파일(현재 엑셀화면에 활성화된 파일)
   
    T = sht1.Range("B3")      '// 사과이름
    U = sht1.Range("C3")      '// 등급
    a = sht1.Range("D3")     '// 입고일
    b = sht1.Range("E3")     '// 입고일
    c = sht1.Range("F3")     '// 출하일
    d = sht1.Range("G3")     '// 출하일
    
    strSQL = "SELECT * FROM [Data$] "           '// 엑셀시트이면 뒤에 $ 를 붙인다. Data Sheet 가 존재해야 한다.
    If T <> vbNullString Then strSQL = strSQL & "Where 사과이름=""" & T & """"     '// 사과이름 필드 (텍스트 변수 처리)
    If U <> vbNullString Then strSQL = strSQL & " and 등급=""" & U & """"        '// 등급 필드 (텍스트 변수 처리)
   
    If a <> vbNullString And b <> vbNullString Then
        strSQL = strSQL & "And (입고일 Between #" & a & "# And #" & b & "#) "  '// 입고일 a~b 일까지 (날짜변수 처리)
    ElseIf a <> vbNullString And b = vbNullString Then
        strSQL = strSQL & "And (입고일 = #" & a & "#) "     '// 입고일 a (날짜변수 처리)
    ElseIf a = vbNullString And b <> vbNullString Then
        strSQL = strSQL & "And (입고일 = #" & b & "#) "     '// 입고일 b (날짜변수 처리)
    End If
   
    If c <> vbNullString And d <> vbNullString Then
        strSQL = strSQL & "And (출하일 Between #" & c & "# And #" & d & "#) "    '// 입고일 a~b 일까지 (날짜변수 처리)
    ElseIf c <> vbNullString And d = vbNullString Then
        strSQL = strSQL & "And (출하일 = #" & c & "#) "     '// 입고일 a (날짜변수 처리)
    ElseIf c = vbNullString And d <> vbNullString Then
        strSQL = strSQL & "And (출하일 = #" & d & "#) "     '// 입고일 a (날짜변수 처리)
    End If
'    strSQL = strSQL & "Order By 사과이름"       '// 사과이름 기준으로 오름차순 정렬
   
    With conn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FilePath & FileName & ";" & _
            "Extended Properties=Excel 12.0;"
        .Open
    End With
   
    Set RS = conn.Execute(strSQL)
   
    With ActiveWorkbook.ActiveSheet.Range("A5")    '// A5열부터 데이터 출력
        .CurrentRegion.Offset(1).ClearContents    '// 현재 존재하는 값을 전부 삭제
        sRow = Cells(Rows.Count, "A").End(3)(2).Row     '// 첫번째 값을 뿌릴 행의 값
       
        NoRecords = False
        With RS
            FieldCount = .Fields.Count      '// 전체 필드(제목열)의 개수
            For i = 0 To .Fields.Count - 1     '// 레코드셋 제목 전부 가져오기
                sht1.Cells(5, 1).Offset(, i) = .Fields(i).Name
            Next i
           
            If Not (.BOF And .EOF) Then
                NoRecords = False
                .MoveFirst
                While Not .EOF
                    .MoveNext
                    RSCount = RSCount + 1   '// 전체 레코드수 구하기
                Wend        '// 주어진 조건이 True인 동안은 일련의 문을 계속 실행
            Else
                NoRecords = True
                MsgBox ("No records in target")
                Exit Sub
            End If
           
            .MoveFirst      '// 레코드의 처음으로 이동
            While Not .EOF      '// EOF 를 만나기 전까지 계속 반복하라
                For i = sRow To sRow + RSCount - 1 Step 1   '// 총 행의 수만큼 반복
                    For j = 1 To FieldCount Step 1      '// 총 열의 수만큼 반복
                        sht1.Cells(i, j) = .Fields(j - 1)        '// 셀에 값을 기록하라
                    Next j
                    .MoveNext   '// 다음 레코드(행)으로 이동
                Next i
            Wend
        End With
    End With
    RS.Close
    conn.Close
    Set RS = Nothing
    Set conn = Nothing
   
    MsgBox RSCount & "개 데이터 가져오기 완료"
End Sub

작업량의 시간을 그래프처럼 보기좋게 자동으로 찾아서 표시를 해주고 싶은 경우에 사용할 수 있는 VBA 코드입니다.

작업량실적그래프표시.xlsm

Sub 작업량실적그래프표시()
    Dim rngDB As Range

    Dim lookup_array As Range
    Dim rngC As Range
    Dim n, endRow As Integer
   
    Set rngDB = Range([N3], Cells(Rows.Count, "N").End(3))
    Set lookup_array = Range("B2", "K2")
    endRow = Cells(Rows.Count, "N").End(3).Row
    Range([B3], Cells(endRow, "K")).Interior.Color = xlNone    '// 색상 초기화
   
    For Each rngC In rngDB
        n = WorksheetFunction.Match(rngC, lookup_array, 0)
        '// MACTH(현재 표에서 찾고자 하는 셀, lookup_array,0) 는 일치하는 위치가 몇번째인지를 반환
        '// lookup_array 를 행/열의 구간범위내에서 몇번째인지 반환
        '// 0 (FALSE)은 match type으로 정확하게 일치하는 값만 가져오라는 의미
'        MsgBox n    '// 직접 숫자를 확인하고 싶다면 ...
        Cells(rngC.Row, 2).Resize(1, n).Interior.Color = RGB(255, 210, 210)
        '// RGB 색상표 색상을 쉽게 찾으려면 http://link2me.tistory.com/591 참조
    Next rngC
   
End Sub

내 컴퓨터의 MAC 주소를 가져오는 VBA 코드입니다.

구글링해서 외국사이트에서 찾아서 테스트 해봤더니 잘 되네요

먼저 내 PC의 MAC 주소가 뭔지 알아보겠습니다.

MAC(Media Access Control Address) 는 컴퓨터의 LAN 카드에 저장된 고유식별번호 입니다.

우리가 접속하는 인터넷 브라우저는 IP통신(3 Layer)을 합니다.

IP통신으로는 내 컴퓨터의 MAC주소 정보(2 Layer)는 알 수가 없습니다.

윈도우모양 키 + R 를 누르면 나오는 창에다가 cmd 를 입력하고 엔터키를 치면 아래 화면이 나옵니다.

ipconfig /all 을 입력하면

내 컴퓨터의 MAC주소가 뭔지 알려줍니다.

이 정보를 엑셀에서 가져오는 VBA 코드입니다.

Sub getMACaddress()
    Dim strComputer As String
    Dim objWMIService As Object
    Dim colAdapters As Object
    Dim objAdapter As Object
   
    Worksheets("Setting").Cells(1, 2).Offset(1).ClearContents
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" & "!\\" & strComputer & "\root\cimv2")
    Set colAdapters = objWMIService.ExecQuery _
    ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
   
    For Each objAdapter In colAdapters
        MsgBox "Physical address: " & objAdapter.MACAddress
'        Worksheets("Setting").Cells(Rows.Count, 2).End(3)(2) = objAdapter.MACAddress
    Next objAdapter
End Sub

실행(F5)를 하면 팝업창이 뜨는데 정보를 비교하면 똑같다는 걸 알 수 있습니다.

getMACaddress.vbs

필요하신 분은 첨부파일 받아가세요.

표에서 특정한 값이 들어 있는 행만 굵은선으로 테두리를 씌우고 싶은 경우에 대한 문의 사항이 있어서 작성해봤습니다.

특정숫자테두리선.xlsm

VBA 코드는 아래와 같습니다.

VBA 코드 작업을 하다보니 구간범위 설정할 때 Cells(Rows.Count,"G").End(3) 과 같은 걸 잘못 지정하면 원하지 않는 결과가 나올 수도 있습니다.

무슨 말인고 하면 G열의 데이터가 들어있는 마지막셀을 찾으라는 것이라서 만약 G열의 데이터가 전부 삭제되고 없는 경우에는 표 전체에 적용했던 것이 한줄만 적용될 수도 있다는 겁니다.

그래서 가장 마지막 라인의 값이 들어있는 열의 행의 값을 저장했다가 그걸 이용하면 문제가 생기지 않습니다.

Range(rngC, rngC.Offset(, 6)) 의 의미는 rngC 현재 셀, rngC.offset(,6) 은 rngC.offset(0,6) 을 줄여서 사용한 것이며, offset(0,6) 의 의미는 현재셀로부터 행은 변동이 없고, 열쪽으로 6번 우측이라는 뜻입니다.

따라서 Range(시작셀, 마지막셀)은 같은 행에서 열이 7개를 포함하고 있다는 겁니다.

열의 숫자가 다르면 늘려주거나 줄여주면 됩니다.

Sub Thickborder()
    Dim rngC As Range       '// 행을 반복할 변수
    Dim rngAll As Range     '// 표 전체 범위 지정
    Dim rngDB As Range      '// 같은 행의 구간범위 지정
    Dim endRow As Long      '// 표(값이 들어있는) 마지막 행
    Dim k As Integer
       
    Set rngAll = Range([A1], Cells(Rows.Count, "A").End(3)) '// 표의 전체범위 구간 지정
    endRow = Cells(Rows.Count, "A").End(3).Row
    Range([A1], Cells(endRow, "G")).Borders.LineStyle = xlLineStyleNone
    '// 표의 전체 범위 선지정 전부 해제
   
    For Each rngC In rngAll
        If rngC = 1 Then
            Set rngDB = Range(rngC, rngC.Offset(, 6))   '// 같은 행의 범위 지정
            rngDB.BorderAround LineStyle:=xlContinuous, Weight:=xlThick, ColorIndex:=14
            '// 외곽 테두리 선만 원하는 색상으로 지정
            k = k + 1
        End If
    Next rngC
   
    If k > 0 Then
        MsgBox k & " 개 테두리선 표시"
    Else
        MsgBox "표시할 영역이 없음"
    End If
End Sub

요일별로 최대값과 최소값을 구하는 VBA 코드입니다.

weekdayofmaxvalue_vba.xlsm

Option Explicit
Sub weekday_max()
    Dim rngC, rngT As Range
    Dim rngAll, rngDB As Range
    Dim tempMax, tempMin As Double
   
    Set rngAll = Range([F2], Cells(Rows.Count, "F").End(3))
    Set rngDB = Range([C2], Cells(Rows.Count, "C").End(3))
   
    Range([G1], Cells(Rows.Count, "H").End(3)).Offset(1).ClearContents
    '// 요일별 최대값, 최소값 내용 초기화
    tempMin = Application.Max(rngDB)    '// 구간범위내 최대값
   
    For Each rngC In rngAll     '// 월, 화, 수, 목, 금, 토, 일 반복
        For Each rngT In rngDB
            If rngC = rngT.Offset(, 1) Then '// 같은 요일이면
                If rngT > tempMax Then  '// 최대값을 구하라
                    tempMax = rngT
                End If
                If rngT < tempMin Then  '// 최소값을 구하라
                    tempMin = rngT
                End If
            End If
        Next rngT
        rngC.Offset(, 1) = tempMax  '// 셀에 최대값을 저장하라
        rngC.Offset(, 2) = tempMin  '// 셀에 최소값을 저장하라
        tempMax = 0    '// 최대값 초기값 초기화
        tempMin = Application.Max(rngDB)  '// 최소값 초기값 초기화
    Next rngC
End Sub

구간범위 내의 행 전체가 비어 있는 경우에만 삭제하고 싶은 경우의 VBA 코드입니다.

항상 삭제를 할 때에는 아래행부터 시작해서 위로 시작한다는 것을 명심하셔야 합니다.

Sub 행전체가빈셀인경우()
    Dim rngDB As Range
    Dim r, LastRow, k As Double
   
    Application.ScreenUpdating = False  '// 화면 업데이트 일시정지
    LastRow = Cells(Rows.Count, "C").End(3).Row  '// 마지막 셀이 있는 행을 찾기 위해서
   
    For r = LastRow To 1 Step -1
        Set rngDB = Range(Cells(r, "A"), Cells(r, "D")) '// 각 행의 D열까지를 범위구간으로 선언
        If Application.WorksheetFunction.CountA(rngDB) = 0 Then  '// 범위구간 전부가 비어 있으면
            Rows(r).EntireRow.Delete   '// 해당 행 전체 삭제
            k = k + 1       '// 삭제되는 행의 숫자를 카운트 하기 위해
        End If
    Next r   
    MsgBox k & "행 삭제완료"
End Sub

그런데 해당행 전체가 아니라 표의 해당구간내의 경우에만 삭제를 하고 싶다면 어떻게 해야 할까요?

Sub 범위구간의빈셀인경우행삭제()
    Dim rngDB As Range
    Dim r, LastRow, k As Double
   
    Application.ScreenUpdating = False  '// 화면 업데이트 일시정지
    LastRow = Cells(Rows.Count, "C").End(3).Row  '// 마지막 셀이 있는 행을 찾기 위해서
   
    For r = LastRow To 1 Step -1
        Set rngDB = Range(Cells(r, "A"), Cells(r, "D")) '// 각 행의 D열까지를 범위구간으로 선언
        If Application.WorksheetFunction.CountA(rngDB) = 0 Then  '// 범위구간 전부가 비어 있으면
            rngDB.Delete   '// 범위구간의 행 전체 삭제
            k = k + 1       '// 삭제되는 행의 숫자를 카운트 하기 위해
        End If
    Next r   
    MsgBox k & "행 삭제완료"
End Sub

위의 코드와 아래 코드 전부 동일한테 적색으로 표시한 부분만 다릅니다.

결과화면은

다량의 자료를 반복작업을 할 경우, 메모리 크기를 너무 많이 잡으면 오히려 처리가 늦어지게 됩니다.

그래서 적당한 크기로 메모리를 할당하고 반복 작업이 끝나면 메모리 비우는 작업을 한 다음에

반복해서 수행하도록 하면 처리가 빨라집니다.

이중 For 문을 사용하여 안쪽에 있는 For문에서는 SplitLine 만큼 반복해서 수행하도록 합니다.

바깥쪽 For 문에서는 반복할 횟수를 지정합니다.

안쪽 For 문은 실제 원하는 걸 구할 사항을 코딩하는 부분입니다. 즉 가장 핵심적인 사항이죠.

다른 부분은 핵심적인 부분을 얼마나 효율적으로 얻을 수 있게 해주느냐라고 보면 됩니다.

Sub address_merge()
    Dim rngC As Range
    Dim rngAll As Range
    Dim rngDB As Range
    Dim i, k, n As Double
    Dim SplitLine, startRow, LastRow As Double
   
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    oldTime = Timer     '// 시간 변수 설정
    startRow = 2
    SplitLine = 3000
    For n = 1 To (Cells(Rows.Count, "E").End(3).Row \ SplitLine) + 1
        If (SplitLine + startRow) > Cells(Rows.Count, "E").End(3).Row Then
            LastRow = Cells(Rows.Count, "E").End(3).Row     '// 마지막 행이 SplitLine 보다 작으면
        Else
            LastRow = SplitLine + startRow                  '// 마지막 행이 SplitLine 보다 크면
        End If
       
        Set rngDB = Range(Cells(startRow, "E"), Cells(LastRow, "E"))
        For i = startRow To LastRow     '// SplitLine 만큼 반복 수행하라
            If Cells(i, "G") = 0 Then
                Cells(i, "I") = Cells(i, "E") & " " & Cells(i, "F")
            Else
                Cells(i, "I") = Cells(i, "E") & " " & Cells(i, "F") & "-" & Cells(i, "G")
            End If
        Next i
       
        Set rngDB = Nothing
        startRow = i    '// 시작행으로 지정
    Next n
    MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"
End Sub

특정워크 시트를 별도의 파일로 저장하는 VBA 코드입니다.

Sub Sheet_SaveFile()
    Dim sht As Worksheet    '// 각 시트를 넣을 변수
    Dim FileName As String  '// 파일경로+날짜+이름 변수

    Application.ScreenUpdating = False  '// 화면 업데이트 정지
    Set sht = Worksheets("시트명")
    With ActiveSheet
            FileName = ThisWorkbook.Path & "\" & Date & " " & sht.Name & ".xlsx"
            sht.Copy    '// 시트 복사
            With ActiveWorkbook
                 .SaveAs FileName:=FileName '// 새로운 이름으로 저장
                 .Close '// 저장한 파일 닫음
            End With
    End With
    MsgBox "파일 저장완료"
End Sub

엑셀의 각 시트를 전부 파일로 저장하는 VBA 코드입니다.

만약 특정한 시트만 저장하고 싶다면

sht.Visible = True 대신에

sht.Name = "Sheet1" 으로 특정한 시트명을 적어주면 됩니다.

Option Explicit
Sub Sheet_To_SaveFile()   
    Dim sht As Worksheet    '// 각 시트를 넣을 변수
    Dim FileName As String   '// 파일경로+날짜+이름 변수

    Application.ScreenUpdating = False  '// 화면 업데이트 정지
    With ActiveWorkbook
        For Each sht In Worksheets
            FileName = .Path & "\" & Date & " " & sht.Name & ".xlsx"
            If sht.Visible = True Then  '// 숨기지 않은 시트이면
                sht.Copy                     '// 시트를 복사
                With ActiveWorkbook
                    .SaveAs FileName:=FileName '// 새로운 이름으로 저장
                    .Close '// 저장한 파일 닫음
                End With
            End If
        Next sht
    End With
    MsgBox "파일 저장완료"
End Sub

다른 시트에 일치하는 내용이 있는지 검사하여 포함되어 있는 행 출력

Option Explicit

Sub Sheets_FindText()
    Dim rngAll As Range   '// 현재 시트의 범위구간 설정
    Dim rngC As Variant   '// 현재 시트의 범위구간내의 변동되는 셀 변수
    Dim rngDB As Range    '// 검사할 시트의 범위구간 설정
    Dim rngT As Variant   '// 검사할 시트의 범위구간내의 변동되는 셀 변수
    Dim varTemp As Range      '// 임시변수 범위
    Dim i As Long         '// 카운트할 숫자
 
    Range("B2:C10").ClearContents
 
    Set rngDB = Worksheets("B").Range("B2", Worksheets("B").Cells(Rows.Count, "B").End(3))
    Set rngAll = Worksheets("A").Range("A2", Worksheets("A").Cells(Rows.Count, "A").End(3))
 
    For Each rngC In rngAll
        For Each rngT In rngDB
            Set varTemp = rngT.Find(What:=rngC, Lookat:=xlPart)   '// 부분일치(xlPart), 전수일치(xlWhole)
            If Not varTemp Is Nothing Then
                rngC.Offset(, 2) = rngC.Offset(, 2) & " , " & rngT.Offset(, -1)
                i = i + 1
            End If
        Next rngT
   
        rngC.Offset(0, 1) = i
        i = 0
        rngC.Offset(, 2) = Mid(rngC.Offset(, 2), 4, Len(rngC.Offset(, 2)))
        Debug.Print InStr(rngC.Offset(, 2), "1"), Len(rngC.Offset(, 2))
    Next rngC
 
    Set rngDB = Nothing      '// 변수 초기화
    Set rngAll = Nothing      '// 변수 초기화
End Sub

네이버 지식인에 올라온 자료를 정리해 본 것입니다.

연속된 15의 개수, 5의 개수, 0의 개수, 10의 개수가 반복횟수 기준으로 얼마나 되는지 구하는 경우입니다.

연속숫자구하기.xlsm

Sub 연속숫자개수구하기()
    Dim rngC, rngT  As Range
    Dim rngAll As Range
    Dim rngVariable As Range  '// 변하는 영역변수
    Dim i As Double  
   
    For Each rngC In Range([B2], Cells(Rows.Count, "B").End(3))
        If rngC <> rngC.Offset(1) Then
            i = 0
            rngC.Offset(, 1) = rngC.Offset(-1, 1) + 1
            rngC.Offset(, 2) = rngC
        Else
            i = i + 1
            rngC.Offset(, 1) = i
        End If
    Next rngC
   
    Set rngT = [D2].End(4)  '// D2 셀로부터 아래로 내려오면서 처음 값이 있는 셀
    For Each rngC In Range([D2], Cells(Rows.Count, "D").End(3))
        Set rngVariable = Range(rngT, rngC)
        If Not IsEmpty(rngC) Then
            rngC.Offset(0, 1) = Application.CountIf(rngVariable, rngC)
        End If
    Next rngC
   
    MsgBox "완료"
   
End Sub

Sub 값채우기()
    Dim rngC  As Range
    Dim i, n, lastCell As Double
   
    lastCell = Cells(Rows.Count, "J").End(3).Row
   
    For i = 1 To lastCell
        For n = 1 To 4
            For Each rngC In Range([E2], Cells(Rows.Count, "E").End(3))
                If Not IsEmpty(rngC) Then
                    If rngC = Cells(i + 3, "J") Then
                        If rngC.Offset(, -1) = Cells(3, n + 10) Then
                            Cells(i + 3, n + 10) = rngC.Offset(, -2)
                        End If
                    End If
                End If
            Next rngC
        Next n
    Next i
    MsgBox "완료"
   
End Sub

네이버지식인에 올라온 질문을 보고 작성을 했습니다.

한문과 발음기호가 분리되지 않은 걸 셀 분리를 하고 싶다는 내용입니다.

이 경우에는 한문이 먼저 나오고 발음기호는 뒤에 나오는 걸 분리하는 VBA Code 입니다.

Sub 한문과기호분리()
    Dim rngC As Range       '// 선택영역 각 셀을 넣을 변수
    Dim rngAll As Range      '// 선택영역 전체 범위 변수
    Dim SplitPoint, i As Integer
    Dim TempStr As String

    Application.ScreenUpdating = False      '// 화면 업데이트 (일시)정지
    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))    '// 범위 구간 지정
    '// A2 는 구간범위 시작셀, Cells(Rows.Count, "A").End(3)은 A열 값이 있는 마지막 셀

    For Each rngC In rngAll     '// rngC 는 각셀을 순환하는 셀, rngAll 은 전체 범위
        For i = 1 To Len(rngC)      '// rngC 셀의 각글자단위로 반복
            TempStr = Asc(Mid(rngC, i, 1))  '// 각 글자를 ASC값으로 변환하여 TempStr 변수에 저장
            If Not (TempStr >= -13663 And TempStr <= -514) Then    '// 한문이 아니면
                SplitPoint = i      '// 한문이 아닌 글자를 만나면 i 값을 기록하라
                Exit For            '// For문을 빠져 나가라
            End If
        Next i
        rngC.Offset(0, 1) = Trim(Mid(rngC, 1, SplitPoint - 1))  '// 현재 rngC 셀 기준으로 우측으로 1칸 이동
        rngC.Offset(0, 2) = Trim(Mid(rngC, SplitPoint, Len(rngC) - SplitPoint + 1))  '// 우측으로 2칸 이동
    Next rngC

    Set rngAll = Nothing  '// 변수 초기화
End Sub

VBA 코드에 아래 코드를 하나 추가하면 체크하는 날짜를 지난 경우에는 자동으로 파일이 삭제됩니다.

Date 는 오늘 날짜이고 , Dateserial 함수에 표기된 날짜는 유효기한 날짜입니다.

Auto_Open 함수명을 다른 이름으로 하면 자동 실행이 안됩니다.

Sub Auto_Open()
    If Date > Dateserial(2015, 3, 25) Then
        With ThisWorkbook
            If .Saved = False Then .Save
            .ChangeFileAccess Mode:=xlReadOnly           
            Kill .FullName
            .Close SaveChanges:=False
        End With
    End If
End Sub

[VBA] 중복데이터 색깔 표시, 중복제거, 정렬

자료를 분류할 때 중복데이터가 들어 있는 걸 쉽게 찾아서 검토한 다음에 제거하고 싶은 경우가 있습니다.

이럴 때는 중복데이터가 들어간 셀을 배경색을 넣어서 표시한 다음에 찾으면 쉽게 구별할 수가 있습니다.

육안으로 찾는다는 것은 엄청난 시간 낭비죠.

VBA 코드를 사용하지 않고 찾는 방법은 필터를 설정하고, 글자순으로 소팅하는 방법이 되겠죠.

하지만 이 또한 일일이 육안 확인을 해야 하는 번거로움이 예상됩니다.

아래 VBA 코드를 이용하면 쉽게 찾아낼 수 있습니다.

Sub 중복색깔표시()
    Dim rngC As Range
    Dim rngAll As Range
    Dim i As Integer
   
    Application.ScreenUpdating = False      '// 화면 업데이트 (일시)정지
    Set rngAll = Range([C2], Cells(Rows.Count, "C").End(3))
    rngAll.Interior.Color = xlNone  '// 적용된 색깔 삭제
   
    For Each rngC In rngAll
        If Application.CountIf(rngAll, rngC) <> 1 Then  '// 중복데이터 있는 경우
            rngC.Interior.ColorIndex = 40   '// 배경색 지정, 색상표는 http://link2me.tistory.com/260 참조
            i = i + 1
        End If
    Next rngC   
    Set rngAll = Nothing

    If i > 0 Then
        MsgBox "중복개수 " & i & "개 발생"
    Else
        MsgBox "중복없음"
    End If
End Sub

그럼 이제 실행된 결과를 한번 보겠습니다.

먼저 소분류 항목에 필터를 걸고, 오름차순이나 내림차순 정렬을 합니다.

그 다음에 색 기준 정렬을 합니다.

이제 중복데이터가 뭔지 눈에 잘 들어오네요.

데이터가 엄청나게 많은 것을 중복 데이터를 육안으로 확인하고 나서 지우고 싶다면 이걸 실행하면 됩니다.

그럼 이제 중복데이터를 편하게 지우는 방법을 더 알아보겠습니다.

위 그림은 중복제거를 할 때 대분류, 소분류 기준을 모두 고려하여 중복데이터를 제거해야 원하는 결과를 얻을 수 있겠네요.

Sub 중복데이터제거()
    [A1].SpecialCells(5).RemoveDuplicates Columns:=Array(2, 3), Header:=xlYes
   
    '// 2번째 열 기준으로 중복제거
    '[A1].SpecialCells(5).RemoveDuplicates Columns:=2, Header:=xlYes
   
    '// 3번째 열 기준으로 중복제거
    '[A1].SpecialCells(5).RemoveDuplicates Columns:=3, Header:=xlYes
End Sub

단 한줄로 중복데이터를 제거할 수 있습니다. array(2,3) 의 의미는 2번째열과 3번째열을 기준으로 하라.

Header:=xlYes 는 헤더가 있다. 헤더가 없을 경우에는 Header:=xlNO 로 한다.

이제 다시 색깔제거 VBA 코드를 사용하면 표시된 색깔이 없어질 것을 확인할 수 있습니다.

그럼 이제 정렬까지 하는 걸 알려줘야지....라고 하면

엑셀에서는

로 하면 됩니다.

그럼 VBA 코드로 한다면 ....

Sub 셀정렬()
    With Range("A1").CurrentRegion
        .Sort key1:=.Cells(1, 2), order1:=1, _
              key2:=.Cells(1, 3), order2:=1, _
              Header:=xlYes
    End With
End Sub

로 하면 됩니다.

order1:=1 에서 1은 오름차순, 2는 내림차순 을 의미하며, key는 최대 3개까지 지정할 수 있습니다.

duplicate_color.vbs

도움이 되셨다면 공감 꾸욱~~ 눌러주는 센스