我正在創建一個工具的一部分,它將兩個 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 并嘗試手動查找它,使用不同的設定沒有運氣,這樣的字串不在這里
It is string as formatting from SAP is general for these account numbers
debug.print output looks like:
x 2 102 168 168 168 168
The x is for blank space (case for debug.print for 51100)
uj5u.com熱心網友回復:
問題在這里
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
您可能會從閱讀
如何避免在 Excel VBA 中使用 Select 中受益。您的代碼不應包含陳述句,并且應為每個, , ,物件.Select
指定一個作業表。否則,Excel 不清楚您指的是哪個作業表,它可能會失敗。 Range
Cells
Rows
Columns
另請閱讀Range.Find 方法的手冊,其中說:
每次使用此方法時都會保存
LookIn
、LookAt
、SearchOrder
和的設定。MatchByte
如果下次呼叫該方法時沒有為這些引數指定值,則使用保存的值。設定這些引數會更改“查找”對話框中的設定,而更改“查找”對話框中的設定會更改在省略引數時使用的保存值。為避免出現問題,請在每次使用此方法時顯式設定這些引數。
您只指定了引數What:=item, LookAt:=xlWhole
,這意味著其他引數可以是隨機的(沒有默認值),用戶在代碼運行之前在查找/替換對話框中使用的任何內容。為了使您的代碼可靠,您需要指定所有代碼。
轉載請註明出處,本文鏈接:https://www.uj5u.com/yidong/440536.html