본문 바로가기
VBA

[VBA] 내일의 로또당첨을 위해(feat. 인생한방!!)

by 일등미노왕국 2022. 4. 14.

인생 뭐있냐..한방이지...

 

최근 고유값을 찾기 위한 배열과 셀기반 구문들을 계속 해오고 있는데

고유값 문제의 단골문제는 로또번호를 구하는 문제가 주를 이루기에 이참에 본인도 만들어 보기로 하였다.

 

https://www.youtube.com/watch?v=RhVgm-zDhX0&t=302s 

엑사남님이 1년전에 만드신걸 이제야 만들게 되다니...반성중~~

 

기본 골격은 엑사남님 파일에서 가져왔다.

엑사남님이 셀기반과 Countif 로 중복값을 걸러내면서 로또번호를 도출하였다면

본인은 최근 계속 사용하고 있는 배열내 고유값을 찾아내는 구문으로 해결하였다.

 

 

로또 번호의 생성과 함께 번호의 구문으로 도형의 색상도 함께 변경되도록 구문을 정리하였다.

 

도형의 텍스트는 셀의 값을 연동시키는 방식으로 하였는데 도형에 바로 로또 번호를 삽입하는 구문은 너무 빨라서 로또 번호가 생성되어 번호들이 바뀌는 결과 없이 매크로를 실행하자마자 바로 결과를 뿌려주기에 딜레이를 주기 위해 엑사남님처럼 색에 출력을 하게 하였다.

 

이런식으로 값들이 출력이 되게 되는데 평소에는 글자색상을 하얀색으로 만들어서 육안으로 안보이게 하였다. 재밌게도 이 숫자들을 숨기기 해버리면 이상하게도 본인 코드에서는 쉐이프에 번호를 바로 출력하여 숫자들이 교차하는것이 보이지 않기에 부득이 하게 노출하였다...본인 PC 성능 때문인지는 모르겠으나 암튼 번호는 이런식으로 가렸다.

 

구문자체는 어렵지 않았으나, 원하는 퍼포먼스를 하기 위한 딜레이 구문을 주는것이 의외로 시간을 많이 잡아먹었다...ㅜ.,ㅡ

 

Application.Wait Now() + TimeValue("00:00:01")는 1초 딜레이 구문이다.

 

1초보다 더 적은 딜레이를 위해서는 아래와 같이 약간의 트릭을 사용하여야 한다.

Application.Wait Now() + TimeValue("00:00:00") / 2 : 0초의 1/2 -> 0.5초

Application.Wait Now() + TimeValue("00:00:00") / 2 : 0초의 1/4 -> 0.25초

Application.Wait Now() + TimeValue("00:00:00") / 2 : 0초의 1/4 -> 0.25초

Application.Wait Now() + TimeValue("00:00:01") - TimeValue("00:00:00") / 3 : 1초 - 0.25초 =0.75초

 

Option Explicit

Sub Haja_Lotto_Make()

    Dim i&, j&                                          '= i 임의의 반복 / j는 로또번호순환
    Dim rngAll As Range: Set rngAll = [b2:g2]           '= 번호가 생성될 전체영역
    Dim rngx As Range: Set rngx = [b2]                  '= 번호가 개별로 생성될 영역
    Dim Vtemp()                                         '= 생성될 번호를 담을 임시 배열
    Dim shp As Object                                   '= 로또 번호 Shape
    
        ReDim Vtemp(1 To 6)                             '= 로또번호를 담을 임시 배열
        For i = 1 To 30                                 '= 번호들을 롤링 시키기 위해 임의적으로 순환
            For j = 1 To 6                              '= 로또 번호를 생성하기 위한 반복문
              
               Call Haja_Lotto(j, rngx, shp, Vtemp)     '= 로또 번호와 그에 해당하는 쉐이프 색상 변경을 위한 호출
               Application.Wait Now() + TimeValue("00:00:00") / 2  '= 0초의 1/2 즉 0.5초 딜레이
            Next j
            
        Next i
        
        For Each shp In ActiveSheet.Shapes              '= 결과값을 도출하기 위해 쉐이프들을 순환하면서
        
            shp.Fill.ForeColor.RGB = vbBlack            '= 배경색을 검정으로 해라
        
        Next shp
     
        rngAll = ""                                     '= 쉐이프의 값들을 초기화해라
   
        
        Application.Wait Now() + TimeValue("00:00:01")  '= 1초 딜레이
        
        ReDim Vtemp(1 To 6)                             '= 결과값 출력을 위해 배열 초기화
        
       
            For j = 1 To 6
                
                Call Haja_Lotto(j, rngx, shp, Vtemp)    '= 최종 로또값 출력
                Application.Wait Now() + TimeValue("00:00:01") - TimeValue("00:00:00") / 3
                
            Next j
        
        Application.Speech.Speak Range("K2")            '= 로또 번호를 스프커로 음성호출
    
End Sub
Sub Haja_Lotto(j&, rngx As Range, shp As Object, Vtemp)
    
     Dim lotto&
     Do
         Randomize                                      '= 랜덤하게
         lotto = Application.RandBetween(1, 45)         '= 로또값을 생성
         
         If IsError(Application.Match(lotto, Vtemp, 0)) Then    '= 배열내에 값이 없다면 / 중복이 없다면
            Vtemp(j) = lotto                            '= 임시배열에 로또값 저장
             
            Set shp = ActiveSheet.Shapes("Oval " & j)   '= 쉐이프 이름을 선언하고
             
            rngx(1, j) = lotto                          '= 중복값이 아니기에 로또값을 셀에 출력
            
            Select Case lotto                           '= 로또값에 따라 구간에 따른 쉐이프 색상을 달리한다.
    
                 Case Is < 11: shp.Fill.ForeColor.RGB = vbYellow
                 Case 11 To 20: shp.Fill.ForeColor.RGB = vbBlue
                 Case 21 To 30: shp.Fill.ForeColor.RGB = vbRed
                 Case 31 To 40: shp.Fill.ForeColor.RGB = vbBlack
                 Case Else: shp.Fill.ForeColor.RGB = vbGreen
    
            End Select
            
            Exit Do
         End If
    Loop

End Sub

Haja_Lotto(22.04.14).xlsm
0.02MB

댓글