我一直在改变"偏移"尝试将姓名和号码移到我想要的地方,但是,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
答案 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