VBA 找不到工作 - 匹配项目不在 table
VBA find not working - matched items not in table
我正在创建一个工具的一部分，它将两个 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 代表空白 space（debug.print 代表 51100）
这里有问题
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、[= 指定一个工作表20=] 对象。否则 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，这意味着其他参数可以是随机的（没有默认值）用户在代码运行之前在 find/replace 对话框中使用的任何参数。
为了使您的代码可靠，您需要指定所有这些。
我正在创建一个工具的一部分，它将两个 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 代表空白 space（debug.print 代表 51100）
这里有问题
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、[= 指定一个工作表20=] 对象。否则 Excel 不清楚您指的是哪个工作表，它可能会失败。
另请阅读 Range.Find method 的手册，其中写道：
The settings for
LookIn,LookAt,SearchOrder, andMatchByteare 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，这意味着其他参数可以是随机的（没有默认值）用户在代码运行之前在 find/replace 对话框中使用的任何参数。
为了使您的代码可靠，您需要指定所有这些。