在此项目中进行某些更改后，无法使VBA阵列写回工作表

Question

我每周都会发布工作表（“玩家跟踪”）中的10列。我正在使用该跟踪表来更新主文件工作表（“播放器目录”）。该代码完全按照预期的方式运行，但是在对项目进行了一些改进之后，此部分将无法正常工作。我做了什么？

1玩家跟踪表应该发生什么-玩家ID，名称，屏幕名称，座席名称，座席ID，费用，RB％，调整RB，总手数和现金手数。 SrcColumns Array（2、3、4、5、6、7、8、10、11、14）。

2 Player Directory应该与PLayer Tracking进行比较，以查看是否有任何更新或添加。类别相同，但行略有不同。 Trgtcolumns Array（2，3，4，10，11，13，12，12，14，15，16，17）

3如果要添加，则应添加行以确保容量。最后6列是应该累积的数字。例如。费用是玩家跟踪的第七列。如果该单元格的值为10，而周报表的值为2。Id希望将现有的10与2相加，因此现在显示为12。]

而且我也没有收到任何错误代码，但是我的代码也可能阻止了该错误代码。当我运行代码时，看起来事情正在发生。即使当我逐步执行它时，一切看起来都很好，但是当子目录结束时，目录页面仍然为空白。

    `Sub DirectoryAdds()
    Const tgtName As String = "Player Directory"
    Const srcFirstRow As Long = 4
    Const tgtFirstRow As Long = 4
    Dim srcColumns As Variant: srcColumns = Array(2, 3, 4, 5, 6, 7, 8, 10, 11, 13, 14)
    Dim tgtColumns As Variant: tgtColumns = Array(2, 3, 4, 10, 11, 13, 12, 14, 15, 16, 17)
    Dim PT As Worksheet: Set PT = PokerBros.Worksheets(Worksheets.Count)
    Dim PD As Worksheet: Set PD = ThisWorkbook.Worksheets(tgtName)
    Dim rng As Range
    Dim Source As Variant, Target As Variant
    Dim NewRow As Long
    Dim Curr As Long
    Dim UB As Long
    Dim i As Long
    Dim k As Long
        If PT Is PD Then MsgBox "Wrong sheet selected.": GoTo exitProcedure
    Set rng = PT.Columns(srcColumns(0)).Find("*", , xlFormulas, , , xlPrevious)
        If rng Is Nothing Then GoTo exitProcedure
        If rng.row < srcFirstRow Then GoTo exitProcedure
        Source = PT.Range(PT.Cells(srcFirstRow, srcColumns(0)), rng)
    Set rng = PD.Columns(tgtColumns(0)).Find("*", , xlFormulas, , , xlPrevious)
        If rng Is Nothing Then GoTo exitProcedure
        If rng.row < tgtFirstRow Then GoTo exitProcedure
        Target = PD.Range(PD.Cells(tgtFirstRow, tgtColumns(0)), rng)
        NewRow = rng.row + 1
        UB = UBound(srcColumns)
        For i = 1 To UBound(Source)
            On Error Resume Next
            Curr = WorksheetFunction.Match(Source(i, 1), Target, 0)
            If Err.Number = 0 Then
                On Error GoTo 0
                GoSub updateExistingRecord
            Else
                On Error GoTo 0
                GoSub addNewRecord
            End If
        Next
        MsgBox "Operation finished successfully."    
        GoTo exitProcedure        
updateExistingRecord:
    Set rng = PD.Cells(Curr + tgtFirstRow - 1, tgtColumns(UB))
        rng.Value = rng.Value + PT.Cells(i + srcFirstRow - 1, srcColumns(UB)).Value
    Return
addNewRecord:
        For k = 0 To UB - 1
            PD.Cells(NewRow, tgtColumns(k)).Value = _
              PT.Cells(i + srcFirstRow - 1, srcColumns(k)).Value
        Next k
    Set rng = PD.Cells(NewRow, tgtColumns(UB))
        rng.EntireRow.Insert
        rng.Value = rng.Value + PT.Cells(i + srcFirstRow - 1, srcColumns(UB)).Value
        NewRow = NewRow + 1
    Return
exitProcedure:
Erase srcColumns
Erase tgtColumns    
updateExistingRecord: Set rng = PD.Cells(Curr + tgtFirstRow - 1, tgtColumns(UB)) rng.Value = 
rng.Value + PT.Cells(i + srcFirstRow - 1, srcColumns(UB)).Value Return addNewRecord: For k = 0 To 
UB - 1 PD.Cells(NewRow, tgtColumns(k)).Value = _ PT.Cells(i + srcFirstRow - 1,  srcColumns(k)).Value 

Next k Set rng = PD.Cells(NewRow, tgtColumns(UB)) rng.EntireRow.Insert  

.Value = rng.Value + PT.Cells(i + srcFirstRow - 1, srcColumns(UB)).Value NewRow = NewRow + 1 Return exitProcedure: Erase srcColumns Erase tgtColumns End Sub`
`

我每周都会发布工作表（“玩家跟踪”）中的10列。我正在使用该跟踪表来更新主文件工作表（“播放器目录”）。这段代码正是在做它的工作...

Answer 1

没有goto / gosub

已编译但未经测试