excel - VBA 发现不工作 - 匹配的项目不在表中

Question

我正在创建一个工具的一部分，它将两个 SAP 导出合并为一个。
我知道导出中可能有多少个帐号(不是每个月全部)，除了查找问题，当帐号不在数据集中但找到并且合并的数据来自上次导出时，我几乎完成了帐号

Option Explicit
Public lcol, lrow As Long
Public tabulka As ListObject
Public ColLetA, ColLetB, kcol, ddcol, zcol, account(1 To 6), header(1 To 10) As String
Public pname, pnameSQA, ftype, wbname, strFolderName, strFolderExists, path, pathS, wbnames As String
Public pvtFld As PivotField
Public Range1, Cell1 As Range
Public quarter, q, yearfile, monthfile, y, m, mm, qp, mp, yp, fm, astrLinks, item, itemh As Variant
Public fdatum As Date
Public wb, wbp, wbco, wbs, wbSUM, wbd, wbps, wbpe As Workbook
Public ws, wsd, wsH, wsN, wsZ, wsO, wss As Worksheet
Public i, x, r, z, v As Integer

Private Sub prepaymentsSTP()

'list of relevant account numbers for STP
account(1) = "51100"
account(2) = "52100"
account(3) = "314100"
account(4) = "314200"
account(5) = "314300"
account(6) = "314400"

'list of relevant headers for STP
header(1) = "Priradenie"
header(2) = "È.dokladu"
header(3) = "PrÚs"
header(4) = "Dr.dokl."
header(5) = "Dát.dokl."
header(6) = "ÚK"
header(7) = "       Èiastka vo FM"
header(8) = "FMena"
header(9) = "Text"
header(10) = "Nák.doklad"

''open workbook, activate sheet
wbnames = "Prepayments STP"
'Workbooks.Open pathS & wbnames
Set wbps = Workbooks(wbnames)
Set wss = wbps.Sheets(wbnames)
wss.Activate

Set ws = wbps.Sheets("Prepayments")
'Set ws = Sheets.Add
'ws.Name = "Prepayments"

'add headers in row 1 of new sheet
    ws.Activate
    Range("A1").Value = "Úèet"
    Range("B1").Value = header(1)
    Range("C1").Value = header(2)
    Range("D1").Value = header(3)
    Range("E1").Value = header(4)
    Range("F1").Value = header(5)
    Range("G1").Value = header(6)
    Range("H1").Value = header(7)
    Range("I1").Value = header(8)
    Range("J1").Value = header(9)
    Range("K1").Value = header(10)

'go back to STP sheet
    wss.Activate
    Range("A1").Select

'loop through accounts and headers to copy data from SAP export to Prepayments sheet/wb
    For Each item In account
        
        wss.Activate
        Range("A1").Select
        On Error Resume Next
        r = Columns("E:E").Find(What:=item, LookAt:=xlWhole).Row
        On Error GoTo 0
            Debug.Print r
            If r > 0 Then

'find header 1 to get count of data for account
                    Rows(r + 4 & ":" & r + 4).Find(What:=header(1)).Offset(2, 0).Select
                    Range(Selection, Selection.End(xlDown)).Select
                i = Selection.Cells.Count
                    
'copy account number i times in new sheet in first column
                    ws.Activate
                lrow = Cells(Rows.Count, 1).End(xlUp).Row
                    Range("A" & lrow + 1).Select
                    
                    For v = lrow + 1 To lrow + i
                        Range("A" & v).Value = item
                    Next v
                    
'declare last row for ws after submitting account number
                lrow = Cells(Rows.Count, 2).End(xlUp).Row
                    
'find header in SAP sheet and copy dataset for searched header and account
                    wss.Activate
                    For Each itemh In header
                        On Error Resume Next
                    x = Rows(r + 4 & ":" & r + 4).Find(What:=itemh).Offset(2, 0).Column
                    z = Rows(r + 4 & ":" & r + 4).Find(What:=itemh).Offset(2, 0).Row
                        Range(Cells(z, x), Cells(z + i - 1, x)).Select
                        Selection.Copy
                    
                        ws.Activate
                    'lcol = Cells(lrow + 1, Columns.Count).End(xlToLeft).Column  'cannot use, as the first line of one column may be empty
                    x = Rows("1:1").Find(What:=itemh).Offset(2, 0).Column

                        Cells(lrow + 1, x).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                        
                        On Error GoTo 0
                       wss.Activate
                    Next itemh
            End If
        
    Next item

End Sub

代码的问题部分是

For Each item In account
        
        wss.Activate
        Range("A1").Select
        On Error Resume Next
        r = Columns("E:E").Find(What:=item, LookAt:=xlWhole).Row
        On Error GoTo 0
            Debug.Print r
            If r > 0 Then

r 为帐号 314300 和 314400 找到，两者都在第 168 行，其中 314200 不在数据集中，有趣的是，在数据集中也没有找到帐号 51100，我想这可能是一些学者的错误，但我是盲人，看不到它。我为查找尝试了不同的属性，但没有任何效果，如果我在数据中使用 ctr+f 并尝试手动查找它，使用不同的设置没有运气，这样的字符串不在这里
它是字符串，因为 SAP 的格式对于这些帐号是通用的
debug.print 输出如下所示:

x 2 102 168 168 168 168

x 表示空格(debug.print 为 51100 的情况)

Answer 1

问题在这里

For Each item In account       
    wss.Activate
    Range("A1").Select
    On Error Resume Next
    r = Columns("E:E").Find(What:=item, LookAt:=xlWhole).Row
    On Error GoTo 0
        Debug.Print r
        If r > 0 Then

是在循环中 r没有重置!所以 On Error Resume Next防止错误并离开 r使用旧值(来自循环的上一次迭代)!
解决方法:初始化 r对于循环中的每次迭代

For Each item In account       
    wss.Activate
    Range("A1").Select
    r = 0 ' Initialize r for each iteration in the loop
    On Error Resume Next
    r = Columns("E:E").Find(What:=item, LookAt:=xlWhole).Row
    On Error GoTo 0
        Debug.Print r
        If r > 0 Then

你可能会从阅读中受益
How to avoid using Select in Excel VBA .
您的代码不应包含 .Select语句，您应该为 指定一个工作表每 Range , Cells , Rows , Columns目的。否则，Excel 不清楚您指的是哪个工作表，它可能会失败。
另请阅读 Range.Find method 的手册它说:

The settings for LookIn, LookAt, SearchOrder, and MatchByte are saved each time you use this method. If you don't specify values for these arguments the next time you call the method, the saved values are used. Setting these arguments changes the settings in the Find dialog box, and changing the settings in the Find dialog box changes the saved values that are used if you omit the arguments. To avoid problems, set these arguments explicitly each time you use this method.

您只指定了参数 What:=item, LookAt:=xlWhole这意味着在代码运行之前，对于用户在查找/替换对话框中使用的任何参数，其他参数可以是随机的(没有默认值)。
为了使您的代码可靠，您需要指定所有代码。