VBA Лучший способ сопоставить идентификационный номер из электронной таблицы с другим листом, а затем обновить информацию

Question

Я делаю проект Excel Workbook для покер-рума. В программе есть база данных игроков. У каждого игрока есть номер ID.
Ради моего вопроса я собираюсь обратиться к двум листам.
Когда игрок заходит в этот день, он регистрируется с Name, * 1005. * и Time (Этот лист Рабочие листы ("Выплата") ). Лист выплат
Затем, когда игрок покупает покерные фишки, они добавляются на другой лист ( Рабочие листы («Вкладка») ). Таблица вкладок Этот лист сохраняет отслеживание купленных фишек. Некоторые из этих игроков получают кредиты из дома, поэтому в итоге получают Tab. На листе «Вкладка» есть кнопка cmd, которая называется Cashout.

Когда игрок заканчивает день, цель состоит в том, чтобы нажать кнопку вывода средств и отправить оставшиеся вкладки и время окончания игры на лист «Вывод средств». Поскольку на обоих этих листах указан номер игрока ID, я думаю, что именно так я должен найти запись на странице вывода средств, но дайте мне знать, если есть более простой способ.

Он работает с использованием циклов do и выбора ActiveCell, но кода много, а select замедляет процесс. Я знаю, что есть лучший способ сделать это, возможно, Find, Match или даже For Each l oop. Пожалуйста, дайте мне знать, чтобы изменить мой код.
Я прилагаю код, который работает, но я не хочу его использовать.

Private Sub CmdBtnCashout1_Click()
    Dim LastRow As Long
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Rng3 As Range
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim cnt As Integer
    Set ws1 = Worksheets("Tab")
    Set ws2 = Worksheets("Cashout")
    Set Rng1 = Worksheets("Tab").Range("A5")
    Set Rng2 = Worksheets("Tab").Range("C4")
    Set Rng3 = Worksheets("Tab").Range("W5")
    cnt = 1

Application.ScreenUpdating = False
Rng1.Select
Selection.Copy
ws2.Activate
ws2.Range("A4").Select
If ws2.Range("A4") = "" Then
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Activate
    Rng2.Select
    Application.CutCopyMode = False
    Selection.Copy
    ws2.Activate
    ActiveCell.Offset(0, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Activate
    Rng3.Select
    Application.CutCopyMode = False
    Selection.Copy
    ws2.Activate
    ActiveCell.Offset(0, 3).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws2.Range("A1").Select
    ws1.Activate
    ws1.Range("A1").Select
    Application.CutCopyMode = False
    Range("A1").Select
Else
    Do Until ActiveCell.value = ""
        ActiveCell.Offset(1, 0).Select
        cnt = cnt + 1
            If cnt > 49 Then Exit Do
    Loop
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Activate
    Rng2.Select
    Application.CutCopyMode = False
    Selection.Copy
    ws2.Activate
    ActiveCell.Offset(0, 2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws1.Activate
    Rng3.Select
    Application.CutCopyMode = False
    Selection.Copy
    ws2.Activate
    ActiveCell.Offset(0, 3).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ws2.Range("A1").Select
    ws1.Activate
    ws1.Range("A1").Select
    Application.CutCopyMode = False
    Range("A1").Select
End If

    Application.ScreenUpdating = True

End Sub

Таблица вкладок : с кнопкой вывода средств: имя игрока находится в ячейке A5, идентификационный номер - в A4, баланс вкладок - в W5.

Таблица выплат : имя игрока находится в диапазоне A4: A53, а номер идентификатора игрока находится в диапазоне B4: B53 - это то место, где мне нужно будет соответствовать моя ссылка затем вставить баланс вкладки из листа вкладок в диапазоне G4: G53 в строке с этим игроком. Я также хочу просто вставить отметку времени в E4: E53.

Подпункт будет подпрограммой уровня рабочего листа на вкладке с использованием события CashoutCommandBtn Click

Как мне это сделать?

Answer 1

Я нашел способ сделать это с помощью прилагаемого кода, который отлично работает, за исключением того, что у меня есть 20 сабов для 20 кнопок. Я знаю, что есть способ поместить длинный код в модуль и вызвать его из подпрограммы, поэтому я попытаюсь поработать над этим, чтобы у 20 подпрограмм был как минимум минимальный код вместо длинного кода.

\\ Private Sub CmdBtnCashout1_Click ()

    Dim Rng2 As Range
    Dim TimeOut As Date
    Dim wst As Worksheet
    Dim wsco As Worksheet
    Dim Rng1 As Range
    Dim Balance As Range
    Dim COPlayer As Range
    Dim COPlayerRng As Range
    Dim i As Integer
    Dim j As Integer
    Dim Urng1 As Range
    Dim Urng2 As Range
    Dim UnionRng As Range
    Dim WinLoss As Range
    Dim ChipReturn As Range
    Set COPlayerRng = Worksheets("Cashout").Range("B4:B53")
    Set wst = Worksheets("Tab")
    Set wsco = Worksheets("Cashout")
    i = 4
    j = 5
    Set Rng1 = Worksheets("Tab").Cells(i, 1)
    Set Rng2 = Worksheets("Tab").Cells(1, 1)
    Set Balance = Worksheets("Tab").Cells(j, 23)
    Set WinLoss = Worksheets("Tab").Cells(j, 24)
    Set COPlayer = COPlayerRng.Find(What:=Rng1.value,LookIn:=xlValues,LookAt:=xlWhole)
    Set Urng1 = wst.Range(Cells(i, 1), Cells(j, 1))
    Set Urng2 = wst.Range(Cells(i, 3), Cells(j, 22))
    Set UnionRng = Union(Urng1, Urng2)
    Set ChipReturn = wst.Range(Cells(i, 25), Cells(j, 25))
        TimeOut = Time

        Application.ScreenUpdating = False
        Application.FindFormat.Clear
        Application.ReplaceFormat.Clear
        With COPlayer
            .Offset(0, 7).value = Balance.value
            .Offset(0, 3).value = TimeOut
            .Offset(0, 6).value = WinLoss.value
        End With
        Rng2.Select
        UnionRng.ClearContents
        ChipReturn.ClearContents
        wst.Range("A6:V43").Copy
        wst.Range("A4").PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
        wst.Range("A1").Select
        Application.FindFormat.Clear
        Application.ReplaceFormat.Clear
        Application.ScreenUpdating = True

End Sub \\

Используя несколько переменных и функцию "find" и оператор "with", я получил Решение, которое работает. Я все еще новичок в VBA, поэтому, если есть какой-либо способ упростить этот код или использовать стандартный модуль и вызвать оттуда подпрограмму, чтобы исключить код для 20 кнопок, дайте мне знать. Переменные "i" и "j" используются для подсчета строк в свойстве Cells. Код выше для одной из кнопок на листе. когда нажата командная кнопка, она ищет соответствующее значение для идентификационного номера. После этого он берет данные из ячеек "A4" и "A5 и" C4 "и" V5 "и перемещает эту информацию на другой рабочий лист. Переменные" i "= 4 и" j "= 5. Код следующей кнопки идентичен, за исключением того, что строка меняет «i» = 6 и «J» = 7 и т. д.