帮我把这三个代码合成一个代码，执行先后顺序就是代码1，2，3。代码1：Public wbName
Sub AR()
Set sht = ActiveWorkbook.ActiveSheet
wbName = ActiveWorkbook.Name
ShtName = ActiveSheet.Name
PathName = ThisWorkbook.Path
MacroWbName = ThisWorkbook.Name
'Datefrom = sht.Range("C2").Value 'Dateto = sht.Range("D2").Value DataShtName = "WIP DN"
filePath = “C:\TEMP\EXPORT.XLSX”
If Dir(filePath) <> “” Then
Kill filePath
End If
'连接SAP,运行Tcode***************
Call SAPConnection_Chk(“ZPM022”) '调用SAP连接
If ConnectingStatus = False Then
Exit Sub
End If
Set Sbar = session.findById(“wnd[0]/sbar”)
If InStr(1, Sbar.Text, “You are not authorized”) > 0 Then
AppActivate (wbName)
MsgBox "Please Check: " & Sbar.Text
Exit Sub
End If
'执行SAP************************
'Sheets(“Input”).Select
'Range(“A2”).Select
'Range(Selection, Selection.End(xlDown)).Select
'Selection.Copy
Application.ScreenUpdating = True
Application.WindowState = xlMinimized
session.findById(“wnd[0]/tbar[0]/okcd”).Text = “zpm022”
session.findById(“wnd[0]”).sendVKey 0
session.findById(“wnd[0]/tbar[1]/btn[8]”).press
session.findById(“wnd[0]/usr/cntlGRID1/shellcont/shell”).currentCellColumn = “QMNUM”
session.findById(“wnd[0]/usr/cntlGRID1/shellcont/shell”).contextMenu
session.findById(“wnd[0]/usr/cntlGRID1/shellcont/shell”).selectContextMenuItem “&XXL”
session.findById(“wnd[1]/tbar[0]/btn[0]”).press
session.findById(“wnd[1]/tbar[0]/btn[11]”).press
'??layout************************
'Call layoutfilter(“/WBS”) '??Layout??
'If LayoutStatus = False Then
’ Exit Sub
'End If
'??spreedsheet???************************
'Call Spreedsheet '??spreedsheet???
'??local file???************************
'Call LocalFile(“C:\Users\CNLIXU21\Desktop”, “789.xls”) '??local file???
wait 3
Windows(MacroWbName).Activate
'AppActivate (“Data.xlsm”)
Worksheets(DataShtName).Activate
If ActiveSheet.AutoFilterMode = True Then Cells.AutoFilter
Range(“A1:Q2000”).Clear
Workbooks(“EXPORT.XLSX”).Activate
Range(“A1”).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
’ Range(Selection, Selection.End(xlDown)).Select
'Range(Selection, Selection.End(xlUp)).Select
Selection.Copy
Workbooks(MacroWbName).Activate
Worksheets(DataShtName).Activate
Range(“A1”).Select
'Range(“A” & Cells(Rows.Count, 1).End(xlUp).Row + 1).Select
ActiveSheet.Paste
Columns(“G:G”).Select
Selection.TextToColumns Destination:=Range(“G1”), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.NumberFormat = “General”
With Selection
.HorizontalAlignment = xlLeft
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns(“J:J”).Select
Selection.TextToColumns Destination:=Range(“J1”), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=“,”, FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
Workbooks(“EXPORT.XLSX”).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=False
'**************
Set sht = ActiveWorkbook.ActiveSheet
wbName = ActiveWorkbook.Name
ShtName = ActiveSheet.Name
PathName = ThisWorkbook.Path
MacroWbName = ThisWorkbook.Name
'Datefrom = sht.Range("C2").Value 'Dateto = sht.Range("D2").Value DataShtName = "WIP DR"
filePath = “C:\TEMP\EXPORT.XLSX”
If Dir(filePath) <> “” Then
Kill filePath
End If
'连接SAP,运行Tcode***************
Call SAPConnection_Chk(“ZDNDR003”) '调用SAP连接
If ConnectingStatus = False Then
Exit Sub
End If
Set Sbar = session.findById(“wnd[0]/sbar”)
If InStr(1, Sbar.Text, “You are not authorized”) > 0 Then
AppActivate (wbName)
MsgBox "Please Check: " & Sbar.Text
Exit Sub
End If
'执行SAP************************
'Windows(MacroWbName).Activate
'Sheets(“VBA”).Select
'Range(“A2”).Select
'Range(Selection, Selection.End(xlDown)).Select
'Selection.Copy
Application.ScreenUpdating = True
Application.WindowState = xlMinimized
session.findById(“wnd[0]/tbar[0]/okcd”).Text = “ZDNDR003”
session.findById(“wnd[0]”).sendVKey 0
session.findById(“wnd[0]/usr/ctxtS_VBELN-LOW”).SetFocus
session.findById(“wnd[0]/usr/ctxtS_VBELN-LOW”).caretPosition = 0
session.findById(“wnd[0]/usr/btn%S_VBELN%APP%-VALU_PUSH”).press
session.findById(“wnd[1]/tbar[0]/btn[24]”).press
session.findById(“wnd[1]/tbar[0]/btn[8]”).press
session.findById(“wnd[0]/tbar[1]/btn[8]”).press
session.findById(“wnd[0]”).sendVKey 33
session.findById(“wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell”).setCurrentCell 5, “TEXT”
session.findById(“wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell”).selectedRows = “5”
session.findById(“wnd[1]/usr/ssubD0500_SUBSCREEN:SAPLSLVC_DIALOG:0501/cntlG51_CONTAINER/shellcont/shell”).clickCurrentCell
session.findById(“wnd[0]/usr/cntlGRID1/shellcont/shell”).currentCellColumn = “ZZMATNR”
session.findById(“wnd[0]/usr/cntlGRID1/shellcont/shell”).SelectAll
session.findById(“wnd[0]/usr/cntlGRID1/shellcont/shell”).contextMenu
session.findById(“wnd[0]/usr/cntlGRID1/shellcont/shell”).selectContextMenuItem “&XXL”
session.findById(“wnd[1]/tbar[0]/btn[0]”).press
session.findById(“wnd[1]/tbar[0]/btn[11]”).press
'??layout************************
'Call layoutfilter(“/WBS”) '??Layout??
'If LayoutStatus = False Then
’ Exit Sub
'End If
'??spreedsheet???************************
'Call Spreedsheet '??spreedsheet???
'??local file???************************
'Call LocalFile(“C:\Users\CNLIXU21\Desktop”, “789.xls”) '??local file???
wait 3
Windows(MacroWbName).Activate
'AppActivate (“LPG OCF Forecast.xlsm”)
Worksheets(DataShtName).Activate
If ActiveSheet.AutoFilterMode = True Then Cells.AutoFilter
Range(“A1:BK6666”).Clear
Workbooks(“EXPORT.XLSX”).Activate
Range(“A1”).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
’ Range(Selection, Selection.End(xlDown)).Select
'Range(Selection, Selection.End(xlUp)).Select
Selection.Copy
Workbooks(MacroWbName).Activate
Worksheets(DataShtName).Activate
Range(“A1”).Select
'Range(“A” & Cells(Rows.Count, 1).End(xlUp).Row + 1).Select
ActiveSheet.Paste
Columns(“A:A”).Select
Selection.TextToColumns Destination:=Range(“A1”), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.NumberFormat = “General”
With Selection
.HorizontalAlignment = xlLeft
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Workbooks(“EXPORT.XLSX”).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=False
MsgBox “Done”
End Sub
Public Function wait(Second)
Savetime = Timer
While Timer < Savetime + Second
DoEvents
Wend
End Function代码2：Sub ProcessExcelData_HighSpeed()
’ ???
On Error GoTo ErrorHandler
Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Application.StatusBar = "??????..." Dim startTime As Double: startTime = Timer Dim wb1 As Workbook, wb2 As Workbook Dim ws1 As Worksheet, ws2 As Worksheet Dim dict As Object, newDataDict As Object Dim dataArr As Variant, delRows() As Boolean Dim i As Long, k As Long, counter As Long Dim deleteCount1 As Long, deleteCount2 As Long, updateCount As Long Dim output As String ' ?????? Const PATH1 As String = "C:\Users\Skyler.zheng\OneDrive - Taikoo Engine Services (Xiamen) Company Limited\CR Planning\Inhouse repair control\VBA resource data\Data test.xlsm" Const PATH2 As String = "C:\Users\Skyler.zheng\OneDrive - Taikoo Engine Services (Xiamen) Company Limited\CR Planning\Inhouse repair control\new inhouse repair status.xlsm" ' ?????(????) Set wb1 = Workbooks.Open(PATH1, False, True) Set wb2 = Workbooks.Open(PATH2, False, True) Set ws1 = wb1.Sheets("ZPM008") Set ws2 = wb2.Sheets("All") ' ===== ??1 & 2: ??Excel1 ===== Dim lastRow1 As Long lastRow1 = ws1.Cells(ws1.Rows.Count, "J").End(xlUp).Row dataArr = ws1.Range("A2:J" & lastRow1).Value ' ????????(??Boolean??) ReDim delRows(1 To UBound(dataArr, 1)) As Boolean deleteCount1 = 0 ' ????????? For i = 1 To UBound(dataArr, 1) ' ??1: J?????? If CStr(dataArr(i, 10)) = "HPT STG2 NOZZLE DUMMY ASSY" Then delRows(i) = True deleteCount1 = deleteCount1 + 1 ' ??2: D???5000 ElseIf IsNumeric(dataArr(i, 4)) Then If dataArr(i, 4) > 5000 Then delRows(i) = True deleteCount1 = deleteCount1 + 1 End If End If Next i ' ???????(????:?????) If deleteCount1 > 0 Then Dim newArr() As Variant, idx As Long ReDim newArr(1 To UBound(dataArr, 1) - deleteCount1, 1 To UBound(dataArr, 2)) idx = 0 For i = 1 To UBound(dataArr, 1) If Not delRows(i) Then idx = idx + 1 For k = 1 To UBound(dataArr, 2) newArr(idx, k) = dataArr(i, k) Next k End If Next i ' ???? ws1.Range("A2").Resize(UBound(newArr, 1), UBound(newArr, 2)).Value = newArr End If ' ===== ??3: ??????? ===== Set dict = CreateObject("Scripting.Dictionary") Set newDataDict = CreateObject("Scripting.Dictionary") dict.CompareMode = vbTextCompare ' ????Excel1?F???(??????????) lastRow1 = ws1.Cells(ws1.Rows.Count, "F").End(xlUp).Row dataArr = ws1.Range("F2:F" & lastRow1).Value For i = 1 To UBound(dataArr, 1) If Not IsEmpty(dataArr(i, 1)) Then dict(CStr(dataArr(i, 1))) = 1 End If Next i ' ??Excel2?A??? Dim lastRow2 As Long lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row dataArr = ws2.Range("A2:A" & lastRow2).Value ' ?????? deleteCount2 = 0 updateCount = 0 ReDim delRows(1 To UBound(dataArr, 1)) As Boolean ' ??????? For i = 1 To UBound(dataArr, 1) If Not IsEmpty(dataArr(i, 1)) Then Dim cellValue As String cellValue = CStr(dataArr(i, 1)) If dict.Exists(cellValue) Then newDataDict(cellValue) = 1 Else delRows(i) = True deleteCount2 = deleteCount2 + 1 End If End If Next i ' ?????(????) If deleteCount2 > 0 Then counter = 0 For i = UBound(delRows) To 1 Step -1 If delRows(i) Then ws2.Rows(i + 1).Delete ' ??:????2???,???+1 counter = counter + 1 If counter Mod 500 = 0 Then Application.StatusBar = "????Excel2?: " & counter & "/" & deleteCount2 DoEvents End If End If Next i End If ' ????? lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row Dim newData() As Variant ReDim newData(1 To dict.Count, 1 To 1) counter = 0 ' ????????? Dim key As Variant For Each key In dict.Keys If Not newDataDict.Exists(key) Then counter = counter + 1 newData(counter, 1) = key End If Next key ' ????? If counter > 0 Then ws2.Cells(lastRow2 + 1, 1).Resize(counter, 1).Value = newData updateCount = counter End If ' ???? wb1.Save wb2.Save
Cleanup:
’ ??Excel??
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.StatusBar = False
' ???? Dim execTime As String execTime = Format(Timer - startTime, "0.00") MsgBox "? ????!?? " & execTime & " ?" & vbCrLf & _ "Excel1 ????: " & deleteCount1 & vbCrLf & _ "Excel2 ????: " & deleteCount2 & vbCrLf & _ "Excel2 ????: " & updateCount, _ vbInformation, "????" Exit Sub
ErrorHandler:
MsgBox "?? " & Err.Number & ": " & Err.Description & vbCrLf & _
"??? " & Erl, vbCritical, “VBA???”
Resume Cleanup
End Sub
代码3：Sub UpdateInhouseRepairStatus()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim wsAll As Worksheet, wsZPM008 As Worksheet, wsWIPDN As Worksheet, wsWIPDR As Worksheet Dim wbData As Workbook Dim lastRowAll As Long, lastRowZPM008 As Long, lastRowWIPDN As Long, lastRowWIPDR As Long Dim dictZPM008 As Object, dictWIPDN As Object, dictWIPDR As Object Dim i As Long, matchRow As Long Dim key As String, keyDN As String, keyDR As String Dim startTime As Double startTime = Timer On Error GoTo ErrorHandler ' Initialize dictionaries for fast lookup Set dictZPM008 = CreateObject("Scripting.Dictionary") Set dictWIPDN = CreateObject("Scripting.Dictionary") Set dictWIPDR = CreateObject("Scripting.Dictionary") ' Set reference to current workbook sheets Set wsAll = ThisWorkbook.Sheets("All") ' Open Data workbook Set wbData = Workbooks.Open("C:\Users\Skyler.zheng\OneDrive - Taikoo Engine Services (Xiamen) Company Limited\CR Planning\Inhouse repair control\VBA resource data\Data test.xlsm", False, True) ' Set reference to Data workbook sheets Set wsZPM008 = wbData.Sheets("ZPM008") Set wsWIPDN = wbData.Sheets("WIP DN") Set wsWIPDR = wbData.Sheets("WIP DR") ' Get last rows lastRowAll = wsAll.Cells(wsAll.Rows.Count, "A").End(xlUp).Row lastRowZPM008 = wsZPM008.Cells(wsZPM008.Rows.Count, "F").End(xlUp).Row lastRowWIPDN = wsWIPDN.Cells(wsWIPDN.Rows.Count, "G").End(xlUp).Row lastRowWIPDR = wsWIPDR.Cells(wsWIPDR.Rows.Count, "H").End(xlUp).Row ' Build dictionary for ZPM008 (F column as key, row number as value) For i = 2 To lastRowZPM008 If Not IsEmpty(wsZPM008.Cells(i, "F").Value) Then dictZPM008(CStr(wsZPM008.Cells(i, "F").Value)) = i End If Next i ' Build dictionary for WIP DN (G&J concatenated as key, B column as value) For i = 2 To lastRowWIPDN keyDN = CStr(wsWIPDN.Cells(i, "G").Value) & "|" & CStr(wsWIPDN.Cells(i, "J").Value) dictWIPDN(keyDN) = wsWIPDN.Cells(i, "B").Value Next i ' Build dictionary for WIP DR (H&J concatenated as key, A column as value) For i = 2 To lastRowWIPDR keyDR = CStr(wsWIPDR.Cells(i, "A").Value) & "|" & CStr(wsWIPDR.Cells(i, "C").Value) dictWIPDR(keyDR) = wsWIPDR.Cells(i, "I").Value Next i ' Process data in sheet All For i = 2 To lastRowAll ' Task 1: Update B,D,E,F,H,I,W,J columns from ZPM008 key = CStr(wsAll.Cells(i, "A").Value) If dictZPM008.Exists(key) Then matchRow = dictZPM008(key) wsAll.Cells(i, "B").Value = wsZPM008.Cells(matchRow, "L").Value wsAll.Cells(i, "D").Value = wsZPM008.Cells(matchRow, "E").Value wsAll.Cells(i, "E").Value = wsZPM008.Cells(matchRow, "D").Value wsAll.Cells(i, "F").Value = wsZPM008.Cells(matchRow, "J").Value wsAll.Cells(i, "H").Value = wsZPM008.Cells(matchRow, "R").Value wsAll.Cells(i, "I").Value = wsZPM008.Cells(matchRow, "S").Value wsAll.Cells(i, "W").Value = wsZPM008.Cells(matchRow, "Y").Value wsAll.Cells(i, "J").Value = wsZPM008.Cells(matchRow, "P").Value wsAll.Cells(i, "G").Value = wsZPM008.Cells(matchRow, "I").Value End If ' Task 2: Update N column DN NO. from WIP DN If Not IsEmpty(wsAll.Cells(i, "E").Value) And Not IsEmpty(wsAll.Cells(i, "G").Value) Then keyDN = CStr(wsAll.Cells(i, "E").Value) & "|" & CStr(wsAll.Cells(i, "G").Value) If dictWIPDN.Exists(keyDN) Then wsAll.Cells(i, "N").Value = dictWIPDN(keyDN) End If End If ' Task 3: Update U column DN CREATE DATE from WIP DN (using N column) If Not IsEmpty(wsAll.Cells(i, "N").Value) Then ' Need to build another dictionary for WIP DN B to O mapping ' This could be optimized further if needed For matchRow = 2 To lastRowWIPDN If wsWIPDN.Cells(matchRow, "B").Value = wsAll.Cells(i, "N").Value Then wsAll.Cells(i, "U").Value = wsWIPDN.Cells(matchRow, "O").Value Exit For End If Next matchRow End If ' Task 4: Update O column DR NO. from WIP DR If Not IsEmpty(wsAll.Cells(i, "E").Value) And Not IsEmpty(wsAll.Cells(i, "G").Value) Then keyDR = CStr(wsAll.Cells(i, "E").Value) & "|" & CStr(wsAll.Cells(i, "G").Value) If dictWIPDR.Exists(keyDR) Then wsAll.Cells(i, "O").Value = dictWIPDR(keyDR) End If End If ' Update Q,R,S columns from WIP DR (using O column) If Not IsEmpty(wsAll.Cells(i, "O").Value) Then ' Need to build another dictionary for WIP DR A to N,O,P mapping ' This could be optimized further if needed For matchRow = 2 To lastRowWIPDR If wsWIPDR.Cells(matchRow, "I").Value = wsAll.Cells(i, "O").Value Then wsAll.Cells(i, "Q").Value = wsWIPDR.Cells(matchRow, "L").Value 'DR COMMIT DATE wsAll.Cells(i, "R").Value = wsWIPDR.Cells(matchRow, "K").Value 'FINAL SOLUTION DATE wsAll.Cells(i, "S").Value = wsWIPDR.Cells(matchRow, "N").Value 'CUSTOMER CONFIRM DATE Exit For End If Next matchRow End If Next i wbData.Close False Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True MsgBox "Update completed successfully in " & Format(Timer - startTime, "0.00") & " seconds", vbInformation Exit Sub
ErrorHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
If Not wbData Is Nothing Then wbData.Close False
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
End Sub
本文详细解释了PeopleCode中Exit函数的两种用法：Exit(0)用于终止当前PeopleCode Action，而Exit(1)则用于终止当前步骤。这对于理解应用引擎中的流程控制至关重要。
扫一扫
1629
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
