Логика дилера в покере

Я хочу использовать Excel в качестве своего покерного дилера. Вот код, который генерирует 20 случайных чисел (карточек) от 1 до 52. Вывод первых 20 чисел / карточек находится в столбце A1: A20. Я хотел бы, чтобы следующий набор из 20 номеров / карточек был сгенерирован в A22: A41, 3-м A43: A62 и т. д. Как можно исправить код, чтобы он отображал 1000 рук в столбце A с одной строкой, разделяющей каждый набор? Спасибо.

Sub cards()

Range("A:A").Clear

cardstodraw = 20

For x = 1 To cardstodraw

begL:
    ActiveSheet.Cells(1, 2) = "=Randbetween(1,52)"
    ActiveSheet.Cells(x, 1) = ActiveSheet.Cells(1, 2).Text
    cardvalue = ActiveSheet.Cells(x, 1)
        y = 1
        Count = 0
        Do Until ActiveSheet.Cells(y, 1) = ""
            If ActiveSheet.Cells(y, 1) = cardvalue Then
            Count = Count + 1
            End If:  y = y + 1:  Loop
            If Count > 1 Then GoTo begL

    Next

    Range("B1").Clear


End Sub
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
1
0
183
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Пытаться:

Sub cards()
Dim cardstodraw  As Long, numberofhands As Long, i As Long, j As Long, k As Long
cardstodraw = 20
numberofhands = 50
Range("A:A").Clear
With Application.WorksheetFunction
    For j = 0 To numberofhands - 1
        For i = 1 To cardstodraw
begL:
        Cells(i + k + (j * cardstodraw), 1) = .RandBetween(1, 52)
        If .CountIf(Range(Cells(1 + k + (j * cardstodraw), 1), Cells(20 + k + (j * cardstodraw), 1)), Cells(i + k + (j * cardstodraw), 1)) > 1 Then GoTo begL
        Next i
        k = k + 1
    Next j
End With

End Sub
Ответ принят как подходящий

Ваш код несколько запутан (использование GoTo обычно указывает на то, что что-то можно улучшить). Для получения выборки размером 20 из 1-52 используйте модифицированный Перемешивание Фишера-Йетса:

Option Explicit 'you really should be using this

Function deal(n As Long, k As Long) As Variant
    'returns an array of length k
    'consisting of k numbers in the range 1 to n

    Dim deck As Variant
    Dim i As Long, j As Long, temp As Long

    ReDim deck(1 To n)
    For i = 1 To n
        deck(i) = i
    Next i

    With Application.WorksheetFunction
        'do k steps of a Fisher-Yates shuffle on deck
        For i = 1 To .Min(k, n - 1)
            j = .RandBetween(i, n)
            If i < j Then 'swap
                temp = deck(i)
                deck(i) = deck(j)
                deck(j) = temp
            End If
        Next i
    End With

    ReDim Preserve deck(1 To k)
    deal = deck
End Function

Если вы хотите иметь 1000 рук в столбце A:

Sub ManyHands()
    Dim i As Long
    With Application.WorksheetFunction
        For i = 1 To 1000
            Range(Cells(1 + 21 * (i - 1), 1), Cells(21 * i - 1, 1)).Value = .Transpose(deal(52, 20))
        Next i
    End With   
End Sub

При редактировании Вот модифицированная версия кода, которая раздает карты нескольким игрокам:

Function deal(n As Long, k As Long, players As Long) As Variant
    'returns an array with k rows and players columns
    'consisting of k*players numbers in range 1 to n
    'if players = 1, then the array is 1-dimensional
    'otherwise it is 2-dimensional

    Dim deck As Variant
    Dim i As Long, j As Long, temp As Long
    Dim hands As Variant

    ReDim deck(1 To n)
    For i = 1 To n
        deck(i) = i
    Next i

    With Application.WorksheetFunction
        'do k*players steps of a Fisher-Yates shuffle on deck
        For i = 1 To .Min(k * players, n - 1)
            j = .RandBetween(i, n)
            If i < j Then 'swap
                temp = deck(i)
                deck(i) = deck(j)
                deck(j) = temp
            End If
        Next i
    End With

    ReDim Preserve deck(1 To k * players)
    If players = 1 Then
        deal = deck
        Exit Function
    Else
        ReDim hands(1 To k, 1 To players)
        For i = 1 To k
            For j = 1 To players
                hands(i, j) = deck(players * (i - 1) + j)
            Next j
        Next i
    deal = hands
    End If
End Function

Его можно использовать как:

Sub ManyHands()
    Dim i As Long
    For i = 1 To 1000
        Range(Cells(1 + 11 * (i - 1), 1), Cells(11 * i - 1, 2)).Value = deal(52, 10, 2)
    Next i  
End Sub

Вы можете взять возвращаемое значение и делать с ним все, что захотите, в том числе распечатать его в двух столбцах. Вы также можете изменить deal(), чтобы он принимал третий параметр, который представляет собой количество игроков, с которыми нужно иметь дело, и возвращал двумерный массив, например, deal(52,10,2) вернет массив 10x2, в котором каждый столбец представляет собой 10 карт, розданных одному из игроков.

John Coleman 24.10.2018 12:06

Спасибо, как мы можем заставить код печатать первые 10 чисел / карточек в столбце A и вторые 10 чисел / карточек в столбце B рядом (для каждой руки)?

David Jones 24.10.2018 12:11

Я дам модифицированный ответ, но запись чисел в ячейки - это довольно простой VBA. Я не хочу показаться грубым, но это может помочь найти хорошее руководство. Stack Overflow - это в первую очередь инструмент, который поможет вам решить ваши собственные проблемы с кодированием. Редко бывает, что ответ делает именно то, что вы хотите. Вам нужно будет изменить его, чтобы это было так.

John Coleman 24.10.2018 12:23

Еще раз спасибо, я борюсь с базовым кодированием и много ищу примеры в Интернете.

David Jones 24.10.2018 12:33

Без проблем. Если вы ищете хорошую книгу, чтобы узнать больше, я рекомендую "Программирование Excel VBA для чайников" Джона Уокенбаха. Я впервые изучил VBA из более раннего издания книги, и Валкенбах остается одним из моих любимых авторов VBA.

John Coleman 24.10.2018 12:37

Другие вопросы по теме