繁体   English   中英

VBA 查找功能不工作且难以调试

[英]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:=xlPartLookAt:=xlWholeRange("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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM