Random Numbers VBA, Find the optimal combination VBA

Random Numbers VBA

[prompt]  1에서 45까지 범위 내에서 6개의 숫자를 중복 없이 무작위로 선택한다. 선택된 6개의 숫자를 '데이터' 시트의 A2열부터 내림차순으로 입력한다. 이를 10번 반복한다. 각 행에서 A열 숫자 빼기 F열 숫자의 값은 G열에 넣고, A열 숫자 빼기 B열 숫자의 값은 H열에 넣고, B열 숫자 빼기 C열 숫자의 값은 I열에 넣고, C열 숫자 빼기 D열 숫자의 값은 J열에 넣고, D열 숫자 빼기 E열 숫자의 값은 K열에 넣고, E열 숫자 빼기 F열 숫자의 값은 L열에 넣는다. 이를 만족하는 VBA 함수는

Sub GenerateRandomNumbers()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("데이터")
    
    Dim i As Integer, j As Integer
    Dim numbers(1 To 6) As Integer
    Dim temp As Integer
    
    Randomize ' Seed the random number generator
    
    For i = 1 To 10
        ' Generate 6 unique random numbers between 1 and 45
        For j = 1 To 6
            Do
                temp = Int((45 - 1 + 1) * Rnd + 1) ' Generate a number between 1 and 45
            Loop While IsInArray(temp, numbers)
            numbers(j) = temp
        Next j
        
        ' Sort the numbers in descending order
        Call BubbleSortDescending(numbers)
        
        ' Write the numbers to the sheet
        For j = 1 To 6
            ws.Cells(i + 1, j).Value = numbers(j)
        Next j
        
        ' Calculate differences and write to the sheet
        ws.Cells(i + 1, 7).Value = ws.Cells(i + 1, 1).Value - ws.Cells(i + 1, 6).Value
        ws.Cells(i + 1, 8).Value = ws.Cells(i + 1, 1).Value - ws.Cells(i + 1, 2).Value
        ws.Cells(i + 1, 9).Value = ws.Cells(i + 1, 2).Value - ws.Cells(i + 1, 3).Value
        ws.Cells(i + 1, 10).Value = ws.Cells(i + 1, 3).Value - ws.Cells(i + 1, 4).Value
        ws.Cells(i + 1, 11).Value = ws.Cells(i + 1, 4).Value - ws.Cells(i + 1, 5).Value
        ws.Cells(i + 1, 12).Value = ws.Cells(i + 1, 5).Value - ws.Cells(i + 1, 6).Value
    Next i
End Sub

Function IsInArray(val As Integer, arr As Variant) As Boolean
    Dim i As Integer
    For i = LBound(arr) To UBound(arr)
        If arr(i) = val Then
            IsInArray = True
            Exit Function
        End If
    Next i
    IsInArray = False
End Function

Sub BubbleSortDescending(arr As Variant)
    Dim i As Integer, j As Integer, temp As Integer
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) < arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub

 

Find the optimal combination VBA

[prompt]  '데이터' 시트에서 M열에서 13이면서 N열에서 1인 경우에 H열부터 L열까지의 값을 가져와서 '최대값13'이라는 새로운 시트를 만든 다음, A열에 출력한다. 각 행을 왼쪽부터 오른쪽으로 내림차순 정렬하여 G열에 출력한다. G열부터 K열을 위에서 아래로 내림차순 정렬한다. H열부터 J열에 있는 값을 하나의 튜플로 전환한다. 내림차순 정렬한다. 각각의 개수를 센다. 개수가 많은 튜플부터 M열과 N열에 출력한다. '데이터' 시트에서 M열에서 12이면서 N열에서 1인 경우에 H열부터 L열까지의 값을 가져와서 '최대값12'이라는 새로운 시트를 만든 다음, A열에 출력한다. 각 행을 왼쪽부터 오른쪽으로 내림차순 정렬하여 G열에 출력한다. G열부터 K열을 위에서 아래로 내림차순 정렬한다. H열부터 J열에 있는 값을 하나의 튜플로 전환한다. 내림차순 정렬한다. 각각의 개수를 센다. 개수가 많은 튜플부터 M열과 N열에 출력한다. '데이터' 시트에서 M열에서 14이면서 N열에서 1인 경우에 H열부터 L열까지의 값을 가져와서 '최대값14'이라는 새로운 시트를 만든 다음, A열에 출력한다. 각 행을 왼쪽부터 오른쪽으로 내림차순 정렬하여 G열에 출력한다. G열부터 K열을 위에서 아래로 내림차순 정렬한다. H열부터 J열에 있는 값을 하나의 튜플로 전환한다. 내림차순 정렬한다. 각각의 개수를 센다. 개수가 많은 튜플부터 M열과 N열에 출력한다. 이를 만족하는 VBA 함수는

Sub ProcessAllData()
    ProcessDataForValue 12
    ProcessDataForValue 13
    ProcessDataForValue 14
End Sub

Sub ProcessDataForValue(value As Integer)
    Dim wsData As Worksheet
    Dim wsResult As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long, k As Long
    Dim tempArr() As Variant
    Dim rng As Range
    Dim dict As Object
    Dim key As Variant
    Dim sortedKeys As Variant
    
    ' Set the worksheets
    Set wsData = ThisWorkbook.Sheets("데이터")
    On Error Resume Next
    Set wsResult = ThisWorkbook.Sheets("최대값" & value)
    On Error GoTo 0
    
    ' Create "최대값" sheet if it does not exist
    If wsResult Is Nothing Then
        Set wsResult = ThisWorkbook.Sheets.Add
        wsResult.Name = "최대값" & value
    End If
    
    ' Clear previous content in the result sheet
    wsResult.Cells.Clear
    
    ' Find the last row in "데이터" sheet
    lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    
    ' Initialize row for new sheet
    Dim newRow As Long
    newRow = 1
    
    ' Loop through the "데이터" sheet and check conditions
    For i = 2 To lastRow ' Assuming row 1 is header
        If wsData.Cells(i, "M").Value = value And wsData.Cells(i, "N").Value = 1 Then
            ' Copy values from H to L
            wsResult.Cells(newRow, "A").Resize(1, 5).Value = wsData.Cells(i, "H").Resize(1, 5).Value
            
            ' Copy values to an array and sort them in descending order
            tempArr = wsData.Cells(i, "H").Resize(1, 5).Value
            For j = LBound(tempArr, 2) To UBound(tempArr, 2)
                For k = j + 1 To UBound(tempArr, 2)
                    If tempArr(1, j) < tempArr(1, k) Then
                        Swap tempArr(1, j), tempArr(1, k)
                    End If
                Next k
            Next j
            wsResult.Cells(newRow, "G").Resize(1, 5).Value = tempArr
            
            newRow = newRow + 1
        End If
    Next i
    
    ' Sort columns G to K in descending order
    Set rng = wsResult.Range("G1:K" & newRow - 1)
    rng.Sort Key1:=wsResult.Range("G1"), Order1:=xlDescending, Header:=xlNo
    
    ' Convert values in columns H to J to tuples, sort and count them
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To newRow - 1
        tempArr = wsResult.Cells(i, "H").Resize(1, 3).Value
        Dim tuple As String
        tuple = "(" & tempArr(1, 1) & "," & tempArr(1, 2) & "," & tempArr(1, 3) & ")"
        
        If dict.exists(tuple) Then
            dict(tuple) = dict(tuple) + 1
        Else
            dict.Add tuple, 1
        End If
    Next i
    
    ' Sort dictionary by value (count) in descending order
    sortedKeys = SortDictionaryByValue(dict)
    
    ' Output tuples and their counts to columns M and N
    For i = LBound(sortedKeys) To UBound(sortedKeys)
        wsResult.Cells(i + 1, "M").Value = sortedKeys(i)
        wsResult.Cells(i + 1, "N").Value = dict(sortedKeys(i))
    Next i
End Sub

Sub Swap(a As Variant, b As Variant)
    Dim temp As Variant
    temp = a
    a = b
    b = temp
End Sub

Function SortDictionaryByValue(dict As Object) As Variant
    Dim arr() As Variant
    Dim i As Long, j As Long
    Dim tempKey As Variant
    
    ' Copy keys to an array
    ReDim arr(0 To dict.Count - 1)
    i = 0
    For Each key In dict.Keys
        arr(i) = key
        i = i + 1
    Next key
    
    ' Bubble sort the array based on dictionary values
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If dict(arr(i)) < dict(arr(j)) Then
                tempKey = arr(i)
                arr(i) = arr(j)
                arr(j) = tempKey
            End If
        Next j
    Next i
    
    SortDictionaryByValue = arr
End Function

 

2024.6.14

Random Numbers VBA

Sub GenerateRandomNumbersAndCalculateDifferenceAndSort()
    Dim ws As Worksheet
    Dim i As Integer, j As Integer
    Dim randomNumbers(1 To 30, 1 To 6) As Integer
    Dim diff(1 To 30, 1 To 5) As Integer
    Dim sortedDiff(1 To 30, 1 To 5) As Integer
    Dim temp As Integer
    
    ' Initialize random number generator
    Randomize
    
    ' Set worksheet
    Set ws = ThisWorkbook.Sheets("데이터")
    
    ' Clear previous data in columns A to P
    ws.Range("A2:P31").ClearContents
    ws.Range("G2:K31").Interior.ColorIndex = xlNone
    
    ' Generate 30 sets of 6 unique random numbers
    For i = 1 To 30
        ' Generate 6 unique random numbers between 1 and 45
        randomNumbers(i, 1) = Int((45 - 1 + 1) * Rnd + 1)
        
        For j = 2 To 6
            Do
                randomNumbers(i, j) = Int((45 - 1 + 1) * Rnd + 1)
            Loop Until Not IsInArray(randomNumbers, i, j)
        Next j
        
        ' Sort the array descending (bubble sort)
        For j = 1 To 5
            For k = j + 1 To 6
                If randomNumbers(i, j) < randomNumbers(i, k) Then
                    ' Swap values
                    temp = randomNumbers(i, j)
                    randomNumbers(i, j) = randomNumbers(i, k)
                    randomNumbers(i, k) = temp
                End If
            Next k
        Next j
        
        ' Output sorted numbers to columns A to F
        For j = 1 To 6
            ws.Cells(i + 1, j).Value = randomNumbers(i, j)
        Next j
        
        ' Calculate differences and output to columns G to K
        For j = 1 To 5
            diff(i, j) = randomNumbers(i, j) - randomNumbers(i, j + 1)
            ws.Cells(i + 1, 6 + j).Value = diff(i, j)
        Next j
        
        ' Highlight cells G to K with yellow color
        ws.Range(ws.Cells(i + 1, 7), ws.Cells(i + 1, 11)).Interior.Color = RGB(255, 255, 0)
        
        ' Sort differences descending and output to columns L to P
        For j = 1 To 5
            sortedDiff(i, j) = diff(i, j)
        Next j
        
        ' Sort sortedDiff array descending (bubble sort)
        For j = 1 To 4
            For k = j + 1 To 5
                If sortedDiff(i, j) < sortedDiff(i, k) Then
                    ' Swap values
                    temp = sortedDiff(i, j)
                    sortedDiff(i, j) = sortedDiff(i, k)
                    sortedDiff(i, k) = temp
                End If
            Next k
        Next j
        
        ' Output sorted differences to columns L to P
        For j = 1 To 5
            ws.Cells(i + 1, 11 + j).Value = sortedDiff(i, j)
        Next j
    Next i
End Sub

Function IsInArray(arr As Variant, rowNum As Integer, colNum As Integer) As Boolean
    Dim i As Integer
    
    IsInArray = False
    For i = 1 To colNum - 1
        If arr(rowNum, i) = arr(rowNum, colNum) Then
            IsInArray = True
            Exit Function
        End If
    Next i
End Function