Перезаписать данные, отправляемые в таблицу, если они уже существуют? - PullRequest
0 голосов
/ 14 июля 2020

У меня есть сценарий, который отправляет данные из пользовательской формы в таблицу на сетевом диске. У меня также есть код для заполнения этой таблицы данными обратно в форму, чтобы пользователи могли вносить изменения. Скажем, у меня есть существующая запись, извлеките данные для обновления, как убедиться, что она перезаписывает уже существующую запись вместо добавления дополнительных строк? Могу ли я реализовать оператор if, чтобы проверить, существует ли он уже?

EDITED CODE:

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

1 Ответ

0 голосов
/ 14 июля 2020

Должно выглядеть примерно так:

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

Какой бы код вы ни использовали для загрузки существующей записи, он должен отслеживать, из какой строки она пришла, или вам понадобится какой-то метод для повторного поиска строки, когда вы сохраните запись позже.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...