温馨提示:本文翻译自stackoverflow.com,查看原文请点击:excel - VBA Best way to match an ID number from a spreadsheet to another sheet and then update the informati

excel - VBA匹配电子表格中的ID号到另一张工作表,然后更新信息的最佳方法

发布于 2020-03-29 13:16:05

I am doing an Excel Workbook project for a poker room. There is a Player Database within the program. Each player has an ID number.
For the sake of my question I'm going to refer to two Sheets.
When a player comes in for that day they are logged in with Name, ID, and Time (This sheet is Worksheets("Cashout")). Cashout Sheet
Then when the player buys poker chips they get added to another sheet (Worksheets("Tab")).Tab Sheet This sheet keeps track of the chips that are purchased. Some of these players get loans from the house so they end up with a Tab. On the "Tab" sheet there is a cmd button called Cashout.

When the player is done for the day the goal is to click the cashout button and submit any remaining tab and the players end time to the "Cashout" sheet. Since both of these sheets have the players ID number, I am thinking that is how I should find the record on the Cashout page, but let me know if there is an easier way.

I have it working with using do loops and ActiveCell select, but it is a lot of code, and select slows the process. I know there is a better way to do this possibly Find, Match or even a For Each loop. Please let me know to change my code.
I am attaching the code that works, but I don't want to use it.

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

Tab sheet: with Cashout Button: the player name is in Cell A5, ID number is in A4, tab balance is in W5.

Cashout Sheet: player name is within the range of A4:A53 and Player ID number is in range of B4:B53 this is where i would need to match my reference then insert the tab balance from the Tab Sheet in range G4:G53 on the row with that player. I also want to just insert the time stamp in E4:E53.

The sub would be worksheet level sub on the Tab Sheet using the CashoutCommandBtn Click event

How should I do this?

查看更多

查看更多

提问者
Adam Rhodes
被浏览
14
Adam Rhodes 2020-01-31 17:48

I found a way to do this see the attached code which works perfectly except I have 20 subs for 20 buttons. I know there is a way for me to put the long code into a module and call it from a sub so I am going to try and work on that so that the 20 subs have at least minimal code instead of the long code.

\\ 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

结束子\\

通过使用一些变量以及“ find”函数和“ with”语句,为我提供了有效的解决方案。我还是VBA的新手,因此,如果有什么方法可以简化此代码或使用标准模块,然后从那里调用子程序以消除20个按钮的代码,请告诉我。变量“ i”和“ j”用于计算“单元格”属性中的行。上面的代码用于工作表上的按钮之一。当按下命令按钮时,它将查找ID号的匹配值。完成此操作后,它将从单元格“ A4”,“ A5和“ C4”和“ V5”中获取数据,并将该信息移至另一个工作表中,变量“ i” = 4和“ j” = 5。相同,除了行更改为“ i” = 6和“