问题描述
我的excel宏有问题。 我想在excel文件中找到名称并将其复制到其他单元格中。 我创建了一个带有名称和FOR循环的数组来检查它。在那个for循环中,我正在从数组中查找名称。问题是:如果单元格中数组中没有名称,程序将停止,并给我MsgBox“ No name:” + person(j),然后在该程序停止后。是否可以给用户信息“文件中没有该名称”并跳过此迭代?
非常感谢您的帮助!
这是我的代码:
Sub wyszukaj()
Dim persons As Variant
persons = Array("Dawid","Mikael","John","Alice","Katerine")
Dim rowNum As Long
Dim foundRowNum As String
Dim findName As String
Dim j As Long
For j = LBound(persons) To UBound(persons)
Dim found As Range
Dim curSheet As Worksheet
Dim LastCell As Range
Dim FirstAddr As String
With Range("A:A")
Set LastCell = .Cells(.Cells.Count)
End With
Dim nothingInCell As Object
Set nothingInCell = nothing
Set FoundCell = Range("A:A").Find(persons(j),After:=LastCell)
If FoundCell Is nothing Then
MsgBox ("No name: " + persons(j))
End If
Debug.Print FoundCell.Value
If Not FoundCell <> persons(j) Then
FirstAddr = FoundCell.Address
End If
Next j
Dim counter As Integer
Dim i As Integer
counter = 0
Do Until FoundCell Is nothing
counter = counter + 1
Set FoundCell = Range("A:A").FindNext(After:=FoundCell)
If FoundCell.Address = FirstAddr Then
Exit Do
End If
Loop
foundRowNum = FoundCell.Address
rowNum = Range(foundRowNum).Row
For i = rowNum To rowNum + counter - 1
Cells(i,1).copy Cells(i,8)
Cells(i,2).copy Cells(i,9)
Next i
End Sub
解决方法
您需要使用以下结构:
If FoundCell Is Nothing Then
'nothing found
Else
'something found
End If
依赖FoundCell
的所有部分都必须在上面的Else
部分中。
Sub wyszukaj()
Dim persons As Variant
persons = Array("Dawid","Mikael","John","Alice","Katerine")
Dim rowNum As Long
Dim foundRowNum As String
Dim findName As String
Dim j As Long
For j = LBound(persons) To UBound(persons)
Dim found As Range
Dim curSheet As Worksheet
Dim LastCell As Range
Dim FirstAddr As String
With Range("A:A")
Set LastCell = .Cells(.Cells.Count)
End With
Dim nothingInCell As Object
Set nothingInCell = Nothing
Set FoundCell = Range("A:A").Find(persons(j),After:=LastCell)
If FoundCell Is Nothing Then
'nothing found
MsgBox ("No name: " + persons(j))
Else
'something found
Debug.Print FoundCell.Value
If Not FoundCell <> persons(j) Then
FirstAddr = FoundCell.Address
End If
End If
Next j
Dim counter As Long
Dim i As Long
counter = 0
Do Until FoundCell Is Nothing
counter = counter + 1
Set FoundCell = Range("A:A").FindNext(After:=FoundCell)
If FoundCell.Address = FirstAddr Then
Exit Do
End If
Loop
foundRowNum = FoundCell.Address
rowNum = Range(foundRowNum).Row
For i = rowNum To rowNum + counter - 1
Cells(i,1).Copy Cells(i,8)
Cells(i,2).Copy Cells(i,9)
Next i
End Sub