我一直在研究很多Excel VBA宏代码并取得了很多成就。我遇到了一个问题，我想在其中一个打开的Excel工作簿中搜索关键字，例如 - ABC12345，如果在单元格B2中找到“ABC”，我希望满足条件
到目前为止我的代码：
Sub ABC_Upload()
Sheets("Add File Here").Select
If IsEmpty(Range("A1")) Then
Worksheets("Master Mapper").Activate
Dim answerABC As Integer
answerABC = MsgBox("Please check the Data Sheet. No value found in first row! Do you wish to find XYZ file in open workbooks and start process?", vbYesNo + vbQuestion, "Review & Proceed")
If answerABC = vbYes Then
'Starts here
Dim wSheet As Worksheet
Dim wBook As Workbook
Dim XYZFound As Range
Dim xFound As Boolean
Dim lngLastRow2 As Long
On Error Resume Next
For Each wBook In Application.Workbooks
For Each wSheet In wBook.Worksheets
Set XYZFound = Nothing
Set XYZFound = wSheet.Cells.Find(What:="ABC", After:=wSheet.Cells(1, 1), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
'Set XYZFound = wSheet.Cells.Find(What:="BIC", After:=wSheet.Cells(1, 1), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
'XYZFound.Cells.Select
If Not XYZFound Is Nothing Then
xFound = True
Application.Goto XYZFound, True
'Rows(1, 2).EntireRow.Hidden = True
lngLastRow2 = Cells(Cells.Rows.Count, "B").End(xlUp).Row
Range("A1:E" & lngLastRow2).Copy
ThisWorkbook.Worksheets("Add File Here").Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next wSheet
If xFound Then Exit For
Next wBook
If XYZFound Is Nothing Then
MsgBox "No open file for XYZ Meetings Found. Make sure the most recent XYZ Excel WB is open!", vbCritical + vbOKOnly
Exit Sub
End If
'Ends Here
Sheets("Add File Here").Select
Columns("A").Replace _
What:=";", Replacement:=""
Columns("A").Replace _
What:=":", Replacement:=""
Columns("A").Replace _
What:=",", Replacement:=""
Columns("A").Replace _
What:="(", Replacement:=""
Columns("A").Replace _
What:=")", Replacement:=""
Columns("A").Replace _
What:="{", Replacement:=""
Columns("A").Replace _
What:="}", Replacement:=""
Columns("A").Replace _
What:="[", Replacement:=""
Columns("A").Replace _
What:="]", Replacement:=""
Columns("A").Replace _
What:="~+", Replacement:=""
Columns("A").Replace _
What:="~*", Replacement:=""
Columns("A").Replace _
What:="~?", Replacement:=""
Columns("A").Replace _
What:="_", Replacement:=""
Columns("A").Replace _
What:=".", Replacement:=""
Columns("A").Replace _
What:="'", Replacement:=""
Columns("A").Replace _
What:="\", Replacement:=""
Columns("A").Replace _
What:="/", Replacement:=""
Columns("A").Replace _
What:=".", Replacement:=""
Columns("A").Replace _
What:="@", Replacement:=""
Columns("A").Replace _
What:=Chr(34), Replacement:=""
Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Value = "Client ID"
Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D1").Value = "Client Name"
Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Value = "Planner Name"
Columns("I:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I1").Value = "External System Name"
Dim rng As Range
Dim i As Long
'Set the range in column A you want to loop through
Set rng = Range("B2:B100")
For Each cell In rng
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
cell.Offset(0, 1).Value = "Company ID"
End If
Next
Dim rngC As Range
Dim Ci As Long
'Set the range in column A you want to loop through
Set rngC = Range("C2:C100")
For Each cell In rngC
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
cell.Offset(0, 1).Value = "Company"
End If
Next
Dim rngP As Range
Dim Pi As Long
'Set the range in column A you want to loop through
Set rngP = Range("D2:D100")
For Each cell In rngP
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
cell.Offset(0, 1).Value = "NA"
End If
Next
Dim rnEP As Range
Dim Ei As Long
'Set the range in column A you want to loop through
Set rngE = Range("H2:H100")
For Each cell In rngE
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
cell.Offset(0, 1).Value = "Company"
End If
Next
'MsgBox "File has been formatted for XYZ and is ready for MMS upload.", vbOKOnly
Dim answer As Integer
answer = MsgBox("Temporary File Prepared for XYZ. Do you wish to proceed with MMS_NewMtgs file creation?", vbYesNo + vbQuestion, "Review & Proceed")
If answer = vbYes Then
Call Prepare_OutputFile
Else
MsgBox "Output file not created!! Please select - Click to create MMS Formatted File from Master Mapper.", vbOKOnly
End If
End If
End If
ThisWorkbook.Saved = True
End Sub
任何建议都将不胜感激。
谢谢！
答案 0 :(得分：1)
除了@nwhaught所说的，If xFound = 1 Then Exit For中存在问题。您的xFound被声明为Boolean，尽管您为其设置了1（一）的值，但实际值为True。现在，对于VBA，True不等于1，而您的If条件始终为False。 VBA中True的值为-1，但您不需要此值。只需使用If xFound Then Exit For，因为检查布尔值就足够了，不需要将它与另一个布尔值进行比较。
答案 1 :(得分：0)
您的问题是您没有及时退出内部for循环。在处理完所有工作表后退出外部，这将XYZfound设置为空。
如果你只需要找到一次这个东西，那么将'exit for'移动几行，并在处理工作簿中的下一个工作表之前终止循环。
答案 2 :(得分：0)
您可以使用以下方法缩短搜索行：
Columns("A").Replace ";", ""
Columns("A").Replace ":", ""
Columns("A").Replace ",", ""
Columns("A").Replace "(", ""
Columns("A").Replace ")", ""
Columns("A").Replace "{", ""
.
.
.
.
这是使用 With 命令
的一个很好理由的示例 With Columns("A")
.Replace ";", ""
.Replace ":", ""
.Replace ",", ""
.Replace "(", ""
.Replace ")", ""
.Replace "{", ""
.
.
.
End With
或者这个：
Dim badText As Variant
For Each badText In Array(";", ":", ",", _
"(", ")", "{", "}", "[", "]", _
"~+", "~*", "~?", "_", ".", _
"'", "\", "/", "@", """") ' chr(34) = " (quote), in VBA string it must be escaped by doubling it up
Columns("A").Replace badText, ""
Next badText
另一个简化的地方：
两个范围内容检查您放置文本＆＃34;公司＆＃34;在每个非空单元格旁边
Set rngC = Range("C2:C100")
For Each cell In rngC
.
.
Set rngE = Range("H2:H100")
For Each cell In rngE
.
两个 For 循环可以组合成一个以此行开头的循环：
For Each cell In Range("C2:C100, H2:H100")