如果数据已经存在，是否覆盖发送到 table 的数据？

Question

我有一个脚本可以将数据从用户窗体发送到网络驱动器上的 table。我还有代码将 table 数据填充回表单，供用户进行编辑。假设我有一个现有条目，拉取数据进行更新，如何确保它覆盖已经存在的条目而不是附加额外的行？我可以实现一个 if 语句来检查它是否已经存在吗？

编辑代码：

Private Sub cmdSendData_Click()

    Set wb = Workbooks.Open("\\OFFER_LOG_DATA_TABLE.xlsx")
    Dim wsTgt As Worksheet: Set wsTgt = wb.Worksheets("Sheet1")
    Dim recRow As Range

    'See if there's a match on an existing row
    '  adjust function to suit...
    Set recRow = MatchRow(wsTgt.Range("A1").CurrentRegion, _
                          txtCandidateName.Text, _
                          txtCurrentPosition.Text)

    'If there's no existing row to update then add a new row at the bottom
    If recRow Is Nothing Then Set recRow = wsTgt.Range("A50000").End(xlUp).Offset(1, 0)

    With recRow.EntireRow
        .Cells(1).Value = txtTodays_Date.Text 'section 1
        .Cells(2).Value = Me.cmbReason_for_Offer.Value
        .Cells(33).Value = txtMgrJustification.Text
    End With
        
    
    wb.Close savechanges:=True
    Application.Quit   '????
    wb.Saved = True
        
End Sub

'Return a row from a table based on matches in two columns
'   returns nothing if no match
Function MatchRow(tableRange As Range, lStore, lName) As Range
    Dim rw As Range
    lStore = Me.txtStore.Text
    lName = Me.txtCandidateName.Text
    For Each rw In tableRange.Rows
        'adjust the column numbers/match types as needed
        If rw.Cells(4).Value = lStore Then
            If rw.Cells(16).Value = lName Then
                Set MatchRow = rw
                Exit Function
            End If
        End If
    Next rw
End Function

Answer 1

应该看起来像这样：

Private Sub cmdSendData_Click()

    Set wb = Workbooks.Open("\TABLE.xlsx")
    Dim wsTgt As Worksheet: Set wsTgt = wb.Worksheets("Sheet1")
    Dim recRow As Range 

    'See if there's a match on an existing row
    '  adjust function to suit...
    Set recRow = MatchRow(wsTgt.Range("A1").CurrentRegion, _
                          txtCandidateName.Text, _
                          txtCurrentPosition.Text)

    'If there's no existing row to update then add a new row at the bottom 
    If recRow is nothing then set recRow = wsTgt.Range("A50000").End(xlUp).Offset(1, 0)

    With recRow.EntireRow          
        .cells(1).Value = txtTodays_Date.Text 'section 1
        .cells(2).Value = Me.cmbReason_for_Offer.Value
        '....
        .cells(33).Value = txtMgrJustification.Text
    End With
        
    
    wb.Close savechanges:=True
    Application.Quit   '????
    wb.Saved = True
        
End Sub

'Return a row from a table based on matches in two columns
'   returns nothing if no match
Function MatchRow(tableRange As Range, match1, match2) As Range
    Dim rw As Range
    For Each rw In tableRange.Rows
        'adjust the column numbers/match types as needed
        If rw.Cells(1).Value = match1 Then
            If rw.Cells(3).Value = match2 Then
                Set MatchRow = rw
                Exit Function
            End If
        End If
    Next rw
End Function

无论您必须加载现有记录的什么代码都应该跟踪它来自哪一行，否则您在稍后保存记录时将需要一些方法来重新找到该行。

如果数据已经存在，是否覆盖发送到 table 的数据？

Overwrite data being sent to table if it exists already?

excel

vba

userform