[英]VBA Find Function is not working and hard to debug
find 功能不起作用但其他一切似乎都很好,因为我在其他 excel 文件中进行了测试。 我添加了选项 Explicit 来测试错误,但他们只能发现我没有声明变量,输出是相同的。
Sub ReadDataFromCloseFile()
'
' ReadDataFromCloseFile Macro
'
'
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Dim wb As Workbook
Set wb = ThisWorkbook
Dim src As Workbook
' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
Set src = Workbooks.Open("C:\test.xlsm", True, True)
Dim masterRow_count As Integer
masterRow_count = wb.Worksheets("Sheet1").Range("A1").End(xlDown).Row
Dim row_number As Integer
row_number = 2
Dim strSearch As String
Dim searchrange As Range
Do
Dim result As Range
strSearch = wb.Worksheets("Sheet1").Range("A" & row_number).Value
Set searchrange = src.Worksheets("Sheet1").Range("D:D")
Set result = searchrange.Find(what:=strSearch, LookIn:=xlValues, lookat:=xlValues)
If Not result Is Nothing Then
'Get the data from Asiamiles
src.Worksheets("Sheet1").Range("AB" & result.Row).Copy wb.Worksheets("Sheet1").Range("B", row_number)
src.Worksheets("Sheet1").Range("J" & result.Row).Copy wb.Worksheets("Sheet1").Range("C", row_number)
src.Worksheets("Sheet1").Range("I" & result.Row).Copy wb.Worksheets("Sheet1").Range("D", row_number)
src.Worksheets("Sheet1").Range("N" & result.Row).Copy wb.Worksheets("Sheet1").Range("E", row_number)
src.Worksheets("Sheet1").Range("AD" & result.Row).Copy wb.Worksheets("Sheet1").Range("F", row_number)
src.Worksheets("Sheet1").Range("P" & result.Row).Copy wb.Worksheets("Sheet1").Range("G", row_number)
src.Worksheets("Sheet1").Range("Q" & result.Row).Copy wb.Worksheets("Sheet1").Range("H", row_number)
End If
row_number = row_number + 1
Loop Until row_number = masterRow_count
src.Close SaveChanges:=False
Set src = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
此外,还有另一个问题是它无法关闭 Excel 工作簿。 但这并不是目前最大的问题。
LookAt:=xlValues
应该是LookAt:=xlPart
或LookAt:=xlWhole
, Range("B", row_number)
应该是Range("B" & row_number)
Option Explicit
Sub ReadDataFromCloseFile()
Const SRC_WB = "C:\test.xlsm"
Dim wb As Workbook, wbSrc As Workbook
Dim ws As Worksheet, wsSrc As Worksheet
Dim masterRow_count As Long, row_number As Long
Dim rngSearch As Range, rngResult As Range, strSearch As String
Dim i As Long, n As Long, ar, t0 As Single
t0 = Timer
' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
Application.ScreenUpdating = False
Set wbSrc = Workbooks.Open(SRC_WB, True, True)
Set wsSrc = wbSrc.Worksheets("Sheet1")
With wsSrc
i = .Cells(.Rows.Count, "D").End(xlUp).Row
Set rngSearch = wsSrc.Range("D1:D" & i)
End With
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")
ar = Split("AB,J,I,N,AD,P,Q", ",")
With ws
masterRow_count = .Range("A" & .Rows.Count).End(xlUp).Row
For row_number = 2 To masterRow_count
strSearch = .Range("A" & row_number).Value
Set rngResult = rngSearch.Find(what:=strSearch, _
LookIn:=xlValues, lookat:=xlWhole)
If Not rngResult Is Nothing Then
'Get the data from Asiamiles
For i = 0 To UBound(ar)
.Cells(row_number, "B").Offset(0, i) = wsSrc.Cells(rngResult.Row, ar(i))
Next
n = n + 1
End If
Next
End With
wbSrc.Close SaveChanges:=False
Application.ScreenUpdating = True
MsgBox row_number - 1 & " rows scanned, " & _
n & " rows updated", vbInformation, Format(Timer - t0, "0.0 secs")
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.