[VBA] 반편성하기(메모에 사진넣기)

각 조건에 모두 부합하는 반편성을 구하시오

 

※ 조건1 : 1반 부터 100반까지 1~100까지의 랜덤 숫자 넣기

※ 조건2 : 각 10배수 / 10 = 반편성  ex) 50번일 경우 5반

※ 조건3 : 각 5배수는 각 반 한명만 위치하기(반드시 떨어져야 하는 아이들)

 

코드 진행은 이렇다.

1. 고유값을 전체 영역에 출력한다.

2. 고유값중 10의 배수들은 각 배수의 몫이 해당반에 속해야 한다.

3. 5의 배수중 홀수는 반에 한명씩만 있어야 한다. (메모 사진을 보길 바란다)

4. 학생에 해당하는 사진을 넣는다( 이건 개인 차가 있으니 자신들의 폴더 영역을 수정해야한다.)

 

핵심구문1: 코드 진행 중 숫자 위치를 변경하기 위해

temp = 1 

1=2

2=temp

 

이렇게 하면 1번과 2번의 값을 바꿀 수 있다.

 

 

핵심구문2: 각반에 5의 배수중 홀수가 중복 되었을 경우

5의 배수의 배열의 위치에 고유값들을 담으면서 계속 새로운 값이 나올때마다 비교를 한다.

만일 중복값이 나오면 각 반들을 순환하면서 5의배수가 없는 반을 찾은 다음

그 반 학생중 랜덤으로 한명을 뽑게 되는데 5의 배수가 아니면 핵심구문 1처럼 값과 위치를 변경한다.

 

핵심구문3:  메모에 사진 삽입

Option Explicit
Dim rngAll As Range
Dim rngA As Range

Sub Haja_Class()

    Set rngAll = [c5].Resize(10, 10)        '= 전체영역 설정
    Dim rngF As Range                       '= 조건 2와 3을 각각 찾을 영역
    Dim Vall(1 To 100)                      '= 고유값을 담기 위한 결과 배열
    Dim VB(1 To 10)                         '= 조건 3의 고유값을 담기 위한 배열
    Dim S&, temp&                           '= Temp 값들의 위치 변경을 위한 임시값 , S 1부터 100까지 랜던값
    Dim i&, n&, j&, R&

    rngAll.Clear                            '= 초기화
       
    For Each rngA In rngAll                 '= 전체 영역에 고유값을 뿌리는 구문
        
        Do
        S = Application.RandBetween(1, 100) '= 랜덤값 생성
 
        If IsError(Application.Match(S, Vall, 0)) Then  '= 고유값 배열에 값이 없다면 / 처음 나온 숫자라면
        
            rngA = S                        '= 해당셀에 고유값 S를 담아라
            n = n + 1                       '= 고유값 배열의 크기를 +1 해라
            Vall(n) = S                     '= 고유값 배열에 순차적으로 담아라
            
            Exit Do
        End If
        
        Loop
    Next rngA
    
    For i = 10 To 100 Step 10                        '= 10의 배수의 위치를 조정하는 구문
    
        Set rngF = rngAll.Find(i, lookat:=xlWhole)   '= i값 즉 10의 배수를 찾으면
        temp = Cells(rngF.Row, (i / 10) + 2)         '= rngF 행, i 값 열의 값을 Temp에 넣어라
        Cells(rngF.Row, (i / 10) + 2) = rngF         '= rngF값을 조건에 맞는 위치에 정위치하고
        Cells(rngF.Row, (i / 10) + 2).Interior.ColorIndex = 6   '= 인테리어 색상을 변경해라
        rngF = temp                                  '= 임시값을 변경할 위치에 넣어라
    
    Next i

    For i = 1 To 10                                  '= 5의 배수 위치조정 구문
    
        Set rngF = rngAll.Find(i * 10 - 5, lookat:=xlWhole)  '= 5의 배수 중 홀수 값들을 순차적으로 찾아라
      
        If IsEmpty(VB(rngF.Column - 2)) Then        '= VB 배열이 비어있다면  / 5의 배수가 중복이 아니라면
        
            VB(rngF.Column - 2) = i * 10 - 5        '= VB 배열의 위치에 5의 배수중 홀수를 담아라
         
            Call Haja_Memo_pic(rngF)                '= 해댱 위치에 메모를 삽입해라
            rngF.Interior.ColorIndex = 8            '= 인테리어 색상을 변경해라
        
        Else                                        '= VB 배열의 위치에 값이 존재하면 / 5의 배수가 존재하면
           
            For j = 1 To i                          '= 1부터 i값 만큼 반복하는데
            
             If IsEmpty(VB(j)) Then                 '= 고유값 영역이 있다면
             
                VB(j) = rngF                        '= VB의 위치에 5의 배수값을 담아라
haja:
                R = Application.RandBetween(1, 10)  '= 5의 배수가 없는 행 중 임의값위 위치를 출력해라
                If Cells(4 + R, j + 2) Mod 5 <> 0 Then  '= 임의값이 5의 배수가 아니면
             
                    temp = Cells(4 + R, j + 2)      '= 해당 위치변경을 위한 구문
                    Cells(4 + R, j + 2) = i * 10 - 5
                    Call Haja_Memo_pic(Cells(4 + R, j + 2))   '= 메모에 사진을 뿌려라
                    Cells(4 + R, j + 2).Interior.ColorIndex = 8
                    rngF = temp
                    
                    Exit For                        '= 값을 찾았으면 For을 빠져나와라
                Else
                                
                    GoTo haja
                
                End If
             End If
            
            Next j
        
        End If
        
        
    Next i
    
    rngAll.HorizontalAlignment = xlCenter       '= 셀 서식 영역
    rngAll.Borders.LineStyle = 1
    
End Sub

Sub Haja_Memo_pic(rngF As Range)

    Dim strPath$
    Dim fileName$
    Dim strMemo$
           
    strPath = "C:\Users\Haja\Documents\Haja_반편성\상극"         '= 사진 파일 경로 (본인들에 맞게 수정요함)
       
        
        fileName = strPath & "\" & rngF & ".jpg"                '= 경로 + 숫자 + 확장자
       
        If Dir$(fileName) <> "" Then                            '= 파일이 있다면
           
            With rngF

                .AddComment                                     '= 메모추가
                .Comment.Shape.Fill.UserPicture (fileName)      '= 메모에 그림을 넣음
                .Comment.Shape.LockAspectRatio = msoFalse       '= 그림 좌우비율 고정 해제
                .Comment.Shape.Width = 200
                .Comment.Shape.Height = 150
            End With
               
        End If
   
End Sub

Haja_반편성.zip

2.22MB