Excel VBA-比較工作表中的值並刪除值匹配的特定工作表上的行

Question

這是我到目前為止的內容：

Private Sub CopyDataFromTemporarySheet()
    Dim checkCellSheet_1 As String
    Dim checkRangeSheet_2 As String
    Dim answer As Long
    Dim sheetName As String


    checkCellSheet_1 = Application.ActiveSheet.Cells(3, 2).Value
    checkRangeSheet_2 = AllWeldersData.range("B" & Rows.count).End(xlUp).Value
    sheetName = WQTR_Form.wqtrNumberText.Text


    If checkCellSheet_1 <> checkRangeSheet_2 Then
        range("A3:XFD3").Copy AllWeldersData.range("A" & Rows.count).End(xlUp).Offset(1, 0)
    Else
        answer = MsgBox("A record in ""All Welders Data"" with the WQTR Number: " + checkCellSheet_1 + _
                        " already exists.  Clicking Yes will overwrite the older" _
                        + " record with this new version.  Would you like to continue?" _
                        , vbYesNo, "Record Already Exists.")

        If answer = vbYes Then
            Worksheets("All Welders Data").Activate
            '****
            '*Delete the entire row where CheckRangeSheet_2 is
            '***
            Worksheets(sheetName).Activate
            range("A3:XFD3").Copy AllWeldersData.range("A" & Rows.count).End(xlUp).Offset(1, 0)
        Else
            Exit Sub
        End If
    End If
End Sub

這是它的作用（星號所在位置缺少代碼除外）：它查看單元格中的值（checkCellSheet_1），並將其與所有焊工上的范圍值（列“ B”，checkRangeSheet_2）進行比較。數據表。 如果找到匹配項，則會顯示一個消息框。

如果答案是肯定的，它將復制活動工作表中的一行並將其粘貼為最后一行。

我想念的是如何刪除在“所有焊工數據”表上找到匹配值的行，而我今天似乎仍然無法理解。 我已經嘗試了各種方法，但是我不斷收到類型不匹配警告或無效的限定符。 我相信這很簡單，我只是沒有看到森林里有樹木。 以某種方式，我需要獲取checkRangeSheet_2可變的返回的行號...我認為。

我感謝任何建議。

Answer 1

這成功了

我的原始代碼稍作修改：

Private Sub CopyDataFromTemporarySheet()
    Dim checkCellSheet_1 As String
    Dim checkRangeSheet_2 As String
    Dim answer As Long
    Dim sheetName As String

    checkCellSheet_1 = Application.ActiveSheet.Cells(3, 2).Value
    checkRangeSheet_2 = AllWeldersData.range("B" & Rows.count).End(xlUp).Value
    sheetName = WQTR_Form.wqtrNumberText.Text

    If checkCellSheet_1 <> checkRangeSheet_2 Then
        range("A3:XFD3").Copy AllWeldersData.range("A" & Rows.count).End(xlUp).Offset(1, 0)
    Else
        answer = MsgBox("A record in ""All Welders Data"" with the WQTR Number: " + checkCellSheet_1 + _
                        " already exists.  Clicking Yes will overwrite the older" _
                        + " record with this new version.  Would you like to continue?" _
                        , vbYesNo, "Record Already Exists.")

        If answer = vbYes Then
            Call DeleteRowsWithDuplicateWQTRNumber 'ADDED THIS LINE
            Worksheets(sheetName).Activate  'ADDED THIS LINE
            range("A3:XFD3").Copy AllWeldersData.range("A" & Rows.count).End(xlUp).Offset(1, 0)
        Else
            Exit Sub
        End If
    End If
End Sub

我在If answer = vbYes...添加了兩行，一行調用另一個子程序（請參閱下面的內容），另一行確保執行返回到此點時活動工作表正確。

新的子項如下：

Sub DeleteRowsWithDuplicateWQTRNumber() 'ADDED THIS SUB
    Dim lastRow As Long
    Dim counter As Long
    Dim wqtrNumber

    Worksheets("All Welders Data").Activate

    lastRow = AllWeldersData.range("A1").CurrentRegion.Rows.count
    wqtrNumber = WQTR_Form.wqtrNumberText.Text

    For counter = lastRow To 1 Step -1
        If Cells(counter, 2) = wqtrNumber Then
        Rows(counter).Delete
        End If
    Next
End Sub

這將激活將要刪除該行的工作表，找到當前區域的最后一行，尋找與“ wqtrNumber”匹配的內容（從我的用戶表單中的一個字段開始，但是很容易成為單元格引用），最后刪除找到匹配項的任何行。

然后執行返回到前一個子項，並從另一張紙粘貼到一行中（存在匹配的值，該值也從用戶表單中獲取）。

我進行了一些反復試驗，但是我已經對其進行了多次測試，並且可以正常工作。

更新-上面的代碼不正確

對於正在尋找切實可行的解決方案的任何人：經過進一步測試，我意識到上述代碼無法正常工作。 我對其進行了修改，並進行了數百次測試，一切都按預期進行！ 修改后的代碼如下。

Option Explicit
Dim wqtrNumber As String 'Global Variables
Dim lastRow As Long
Dim counter_1 As Long
Dim counter_2 As Long

Private Sub CopyDataFromTemporarySheet()
    Dim checkCellSheet_1 As String
    Dim checkRangeSheet_2 As String
    Dim answer As Long

    checkCellSheet_1 = Application.ActiveSheet.Cells(3, 2).Value
    checkRangeSheet_2 = AllWeldersData.range("B" & Rows.count).End(xlUp).Value
    wqtrNumber = WQTR_Form.wqtrNumberText.Text
    lastRow = AllWeldersData.range("A1").CurrentRegion.Rows.count

    For counter_1 = lastRow To 1 Step -1
        If checkCellSheet_1 = checkRangeSheet_2 Then
        answer = MsgBox("A record in ""All Welders Data"" with the WQTR Number: " + checkCellSheet_1 + _
                        " already exists.  Clicking Yes will overwrite the older" _
                        + " record with this new version.  Would you like to continue?" _
                        , vbYesNo, "Record Already Exists.")
            If answer = vbYes Then
                Worksheets("All Welders Data").Activate
                Call DeleteRowsWithDuplicateWQTRNumber
                Worksheets(wqtrNumber).Activate
            Else
                Exit Sub
            End If
        ElseIf checkCellSheet_1 <> checkRangeSheet_2 Then
            'Do Nothing!
        End If
        checkRangeSheet_2 = AllWeldersData.range("B" & counter_1).Value
    Next counter_1

    Worksheets(wqtrNumber).Activate
    range("A3:XFD3").Copy AllWeldersData.range("A" & Rows.count).End(xlUp).Offset(1, 0)
End Sub

Sub DeleteRowsWithDuplicateWQTRNumber()

    Worksheets("All Welders Data").Activate

    For counter_2 = lastRow To 1 Step -1
        If Cells(counter_2, 2) = wqtrNumber Then
        Rows(counter_2).Delete
        End If
    Next
End Sub