在工作表值中查找数组数据 - 未获取特定值

时间:2017-03-23 23:37:07

标签: excel vba excel-vba

我一直在改变"偏移"尝试将姓名和号码移到我想要的地方,但是,David和Andrea的电话号码不会转移。

Private Sub CommandButton1_Click()

Dim ws As Worksheet, bFound As Boolean, rFound As Range
Dim a As Long, aNames As Variant

aNames = Array("David", "Andrea", "Caroline")

With Worksheets("Sheet1").Range("A1:E30").Cells
                For a = LBound(aNames) To UBound(aNames)
                    Set rFound = .Find(What:=aNames(a), MatchCase:=False,   LookAt:=xlWhole, SearchFormat:=False)
                    If Not rFound Is Nothing Then
                        bFound = True
                        Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 5).End(xlUp).Offset(3) = rFound.Value
                        Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 6).End(xlUp).Offset(3, 1) = rFound.Offset(, 1).Value
                    End If
                Next a
            End With
    End


If Not bFound Then
    MsgBox "None of the sheets contains the names " & Chr(10) & _
        "'" & Join(aNames, "', '") & "' in cells A1:E30.", vbInformation, "Not Found"
End If

End Sub

2 个答案:

答案 0 :(得分:1)

你的第一个Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 5).End(xlUp).Offset(3) = rFound.Value语句是否正常工作如果您的目标是从“E”列开始,每隔第四行找到一个名称,从E列开始,第一个空单元格在最后一个空单元格之后

而后续的Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 6).End(xlUp).Offset(3, 1) ...语句总是返回相同的单元格地址,因为它始终在第一个空白单元格之后找到第一个空单元格并且您没有在该列中写入任何“新”值

此外,应避免使用End语句,因为它可能带来意外行为

最后,从纯粹的代码逻辑的角度来看,我将Worksheets("Report")放在With语句而不是Worksheets("Sheet1")中,以便不必多次访问(并重复)前者在每个循环中,而后者在循环中只被访问一次,并且我最终将后者设置为范围变量

以上所有我编码的内容如下:

Private Sub CommandButton1_Click()

    Dim ws As Worksheet
    Dim bFound As Boolean
    Dim rFound As Range, rangeToBeSaearchedInRng As Range
    Dim a As Long, aNames As Variant

    aNames = Array("David", "Andrea", "Caroline")

    Set rangeToBeSaearchedInRng = Worksheets("Sheet1").Range("A1:E30") '<--| set your range to be searched in and exploit it inside the loop
    With Worksheets("Report") '<--| reference "Report" worksheet
        For a = LBound(aNames) To UBound(aNames)
            Set rFound = rangeToBeSaearchedInRng.Find(What:=aNames(a), MatchCase:=False, LookAt:=xlWhole, SearchFormat:=False)
            If Not rFound Is Nothing Then
                bFound = True
                With .Cells(.Rows.Count, 5).End(xlUp).Offset(3) '<--| reference referenced worksheet column E first empty cell after last not empty one
                    .Value = rFound.Value '<--| set referenced cell value
                    .Offset(, 1).Value = rFound.Offset(, 1).Value '<--| set the cell value 1 column to the right of referenced cell
                End With
            End If
        Next a
    End With


    If Not bFound Then
        MsgBox "None of the sheets contains the names " & Chr(10) & _
            "'" & Join(aNames, "', '") & "' in cells A1:E30.", vbInformation, "Not Found"
    End If

End Sub

答案 1 :(得分:0)

End(xlUp)函数存在问题,无论是逻辑上还是系统上(意味着,也许Excel无法在更改时尽快计算更改的最后一行)。如果您找到这个问题的答案,您仍然会遇到这样的问题:您可能正在连续编写与姓名不同的电话号码。为什么试试?最好简化(意思是澄清)代码。例如,

    If Not rFound Is Nothing Then
        bFound = True
        With Worksheets("Report")
            R = .Cells(.Rows.Count, 5).End(xlUp).Row + 3
            .Cells(R, 5).Value = rFound.Value
            .Cells(R, 6).Value = rFound.Offset(0, 1).Value
        End With
    End If

有一个更易读的代码,顺便提一下,也说明你的bFound设置是错误的,因为它在任何地方都没有设置为False。我建议在进行以下修改之前,包括上面引用的代码的第一行。

    Set rFound = .Find(What:=aNames(a), MatchCase:=False, LookAt:=xlWhole, SearchFormat:=False)
    bFound = (Not rFound Is Nothing)
    If bFound Then