VBA получает более одного значения для диапазона

Question

Я создаю код, который просматривает весь столбец, чтобы убедиться, что в столбце D нет ячейки, которая уже имеет такое же значение. Моя проблема в том, что я не могу найти способ изменить диапазон для поиска вболее 1 клетки в этом случае D5.Я попытался сделать цикл, но там, где я новичок в кодировании, я не знаю определенного способа.Все, что помогает, высоко ценится.

Sub SaveData()
Dim the_sheet As Worksheet
Dim table_list_object As ListObject
Dim table_object_row As ListRow
Dim Name As String


Set the_sheet = Sheets("Saved Data")

Name = the_sheet.Range("D5")

If Name = Worksheets("Drilling Calculations").Cells(2, 3) Then

MsgBox "Error - Well Name Already Exists. Well Not Saved"

Else

Set table_list_object = the_sheet.ListObjects(1)
Set table_object_row = table_list_object.ListRows.Add

    table_object_row.Range(1, 1).Value = Worksheets("Drilling Calculations").Cells(2, 3)
    table_object_row.Range(1, 2).Value = Worksheets("Drilling Calculations").Cells(5, 5)
    table_object_row.Range(1, 3).Value = Worksheets("Drilling Calculations").Cells(6, 5)
    table_object_row.Range(1, 4).Value = Worksheets("Drilling Calculations").Cells(7, 5)
    table_object_row.Range(1, 5).Value = Worksheets("Drilling Calculations").Cells(8, 5)
    table_object_row.Range(1, 6).Value = Worksheets("Drilling Calculations").Cells(5, 17)
    table_object_row.Range(1, 7).Value = Worksheets("Drilling Calculations").Cells(6, 17)
    table_object_row.Range(1, 8).Value = Worksheets("Drilling Calculations").Cells(7, 17)
    table_object_row.Range(1, 9).Value = Worksheets("Drilling Calculations").Cells(8, 17)
    table_object_row.Range(1, 10).Value = Worksheets("Drilling Calculations").Cells(10, 23)

MsgBox "Data Saved"

End If

End Sub

Answer 1

Попробуйте, дайте мне знать, если понадобится дополнительная помощь ...

Sub SaveData()
Dim the_sheet As Worksheet
Dim table_list_object As ListObject
Dim table_object_row As ListRow
Dim Name As String

    Set the_sheet = Sheets("Saved Data")

    'Get the last row
    Dim lastRow As Long
    lastRow = the_sheet.Cells(sht.Rows.Count, "D").End(xlUp).Row

    Dim bolCheck As Boolean
    Dim R As Long                   'row
    For R = 1 To lastRow            'Iterate through all rows
        If the_sheet.Cells(R, 4) = Worksheets("Drilling Calculations").Cells(2, 3) Then     'If a match found then set to false
            bolCheck = True
            Exit For                'Match found, exit here...
        End If
    Next R

'Now we know if there is a duplicate or not
    If bolCheck Then

        MsgBox "Error - Well Name Already Exists. Well Not Saved"

    Else

        Set table_list_object = the_sheet.ListObjects(1)
        Set table_object_row = table_list_object.ListRows.Add

        table_object_row.Range(1, 1).Value = Worksheets("Drilling Calculations").Cells(2, 3)
        table_object_row.Range(1, 2).Value = Worksheets("Drilling Calculations").Cells(5, 5)
        table_object_row.Range(1, 3).Value = Worksheets("Drilling Calculations").Cells(6, 5)
        table_object_row.Range(1, 4).Value = Worksheets("Drilling Calculations").Cells(7, 5)
        table_object_row.Range(1, 5).Value = Worksheets("Drilling Calculations").Cells(8, 5)
        table_object_row.Range(1, 6).Value = Worksheets("Drilling Calculations").Cells(5, 17)
        table_object_row.Range(1, 7).Value = Worksheets("Drilling Calculations").Cells(6, 17)
        table_object_row.Range(1, 8).Value = Worksheets("Drilling Calculations").Cells(7, 17)
        table_object_row.Range(1, 9).Value = Worksheets("Drilling Calculations").Cells(8, 17)
        table_object_row.Range(1, 10).Value = Worksheets("Drilling Calculations").Cells(10, 23)

        MsgBox "Data Saved"

    End If

End Sub