Question

我正在创建一个代码，该代码将遍历整个列，以确保在D列中没有已经具有相同值的单元格。我的问题是我无法找到一种方法来更改搜索范围在这种情况下为D5，则超过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")

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

VBA在一个范围内获得多个值

1 个答案: