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

【问题标题】：VBA getting more than one value for a rangeVBA 在一个范围内获得多个值
【发布时间】：2018-11-22 16:50:04
【问题描述】：

我正在创建一个代码，该代码将查看一整列，以确保 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

【问题讨论】：

如果您查找有关 for 循环的指南，我认为应该很容易。像Name = the_sheet.Range("D1:D50")（或任何你需要的东西）。然后for each c in Name添加if语句，以此类推。您想将列表与列表进行比较吗？如果需要，也可以很容易地使用条件格式突出显示重复项。
我会研究一下 for 循环，谢谢。但是我正在尝试在表格中添加一行，其中包含通过单独页面上的各种不同计算收集的数据。所以它不是列表形式，只是尝试比较单元格中输入的名称，看看它是否已经在系统中
如果你有一个你希望它如何工作的示例图像，那将有助于我疲惫的大脑正常工作。
那么，在 D 列中，您有一个名称列表，您想检查每个名称是否在哪里重复？
@Kubi 是的，我也是这么想的。直到最后一分钟才弄清楚 OP 需要什么？？？？

标签： vba loops range

【解决方案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

【讨论】：

代码似乎运行正常！感谢您的帮助！