출처 : http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=140251240&qb=7JeR7IWAIOuenOuNpCDsoJXroKw=&enc=utf8&section=kin&rank=1&search_sort=0&spq=0&pid=g/ROCU5Y7twssuA%2Bnhwssc--276450&sid=T-T5VjbL9E8AADeLHBM

 

매크로 사용 익숙하지 않으시면 사용법 동영상 참조 :  http://blog.naver.com/rosa0189/60141785139

좀 복잡해 보이지만 사용법은 간단합니다. 영역 선택하고 동영참 참고하여 매크로 실행만 하면 됨.

 

______________________________________________________________________________________

매크로 실행 후 Yes를 선택하면 각 행에 있는 데이터를 그 행내에서 랜덤하게 섞어주고, No를 선택하면 각 열에 있는 데이터를 그 열내에서 랜덤하게 섞어주는 기능. 2개 이상의 행과 열을 선택(Selection)하고 매크로를 실행해야 함.

 

행과 열로 뒤죽박죽 섞으려면 당연히 Yes와 No를 한 번씩 실행하면 됩니다.

 

 

매크로 실행 전 (영역을 미리 선택하고 매크로 버튼 클릭 전)

 

매크로 실행 후 행으로 섞을지(Yes 선택), 열로 섞을지(No) 묻는 창이 나타남. Cancel 선택시 중단.


                 

Yes선택하여 행으로 섞은 모습                       No를 선택하여 열로 섞은 모습

 

Option Explicit

Sub dhRndSort_Rows_Columns()
   
    Dim vData As Variant                   '선택영역을 넣을 변수
    Dim vResult() As Variant              '섞은 결과를 넣을 변수
    Dim lngRnd() As Long                 '행 또는 열 개수만큼 숫자생성할 동적배열
    Dim lngRows As Long                 '선택영역의 행 개수
    Dim lngCols As Long                   '선택영역의 열 개수
    Dim msg As String '메시지 창에 사용할 변수
    Dim x As Long '열 반복에 사용할 변수
    Dim y As Long '행 반복에 사용할 변수

 

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

    With Selection '선택영역
        vData = .Value '(선택영역)값을 vData에 넣음
        lngCols = .Columns.Count '선택영역의 행 개수 추출
        lngRows = .Rows.Count '선택영역의 열 개수 추출
        If lngCols = 1 Or lngRows = 1 Then '행을 2개 미만으로 선택시
            MsgBox "영역설정 오류. 2행 2열 이상선택", 64, "영역설정오류"
            Exit Sub '메시지 표시하고 매크로 중지
        End If
        
        msg = MsgBox("행으로 섞기 Yes, 열로 섞기 No 선택", vbYesNoCancel, "행열 선택")
        Select Case msg'메시지의 yes, no, cancel 선택중에
            Case vbYes'Yes선택시
                ReDim vResult(1 To lngRows, 1 To lngCols)   '결과 배열의 크기를 재설정
                For y = 1 To lngRows'행 개수만큼 반복
                    lngRnd() = dhRandom(lngCols)'열 개수만큼 함수 호출
                    For x = 1 To lngCols'열 개수만큼 반복
                       vResult(y, x) = vData(y, lngRnd(x)) '랜덤으로 얻은 배열값을 결과배열에 넣음
                    Next x
                Next y
                .Value = vResult'셀에 값을 뿌림
           Case vbNo'No 선택 시
                ReDim vResult(1 To lngRows, 1 To lngCols)   '결과 배열의 크기를 2차원으로 재설정
                For x = 1 To lngCols'열 개수만큼 반복
                    lngRnd() = dhRandom(lngRows)'행 개수만큼 함수 호출
                    For y = 1 To lngRows'행 개수만큼 반복
                       vResult(y, x) = vData(lngRnd(y), x)'랜덤으로 얻은 배열값을 결과배열에 넣음
                    Next y
                Next x
                .Value = vResult'셀에 값을 뿌림
        End Select
    End With

End Sub

 

Function dhRandom(lngNum As Long)
    Dim arrayRnd() As Long                      '1 ~ (행 또는 열 개수)만큼 숫자를 넣을 변수
    Dim uniqueRnd() As Long                   ' 반복없는 숫자를 넣을 변수
    Dim i As Long, j As Long                    '반복구문 및 배열에 사용할 변수
    Dim lngCnt As Long '카운터에 사용할 변수
    
    ReDim arrayRnd(1 To lngNum)             '연속숫자 넣을 배열크기 재지정
    ReDim uniqueRnd(1 To lngNum)          '뒤섞인 유일한 숫자 넣을 배열크기 재지정
    Randomize'랜덤값 초기화
   
    For i = 1 To lngNum'행 또는 열개수만큼 반복
        arrayRnd(i) = i'지정한 숫자까지 연속된 숫자를 배열에 넣음
    Next i
   
    For i = lngNum To 2 Step -1                 '지정숫자만큼 1씩 줄여가며 반복
        j = Int(Rnd * i) + 1'랜덤 값을 생성
        lngCnt = lngCnt + 1'카운터 1씩 증가
       uniqueRnd(lngCnt) = arrayRnd(j)       '생성한 숫자를 순차적으로 유일한 배열에 넣음
       arrayRnd(j) = arrayRnd(i)                  '배열에서 빠진 숫자를 윗값으로 대체
    Next i
   
    uniqueRnd(lngNum) = arrayRnd(1)     '마지막 남은 값을 유일한 배열 제일 뒤에 넣음
    dhRandom = uniqueRnd'얻은 랜덤배열을 함수에 넣어 return.
End Function

Posted by 나른한스누피