VBA 控制 Excel 例子

最新推荐文章于 2025-04-10 14:52:06 发布

原创最新推荐文章于 2025-04-10 14:52:06 发布 · 952 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#vba #excel #integer #string #delete #c

Excel VBA 专栏收录该内容

13 篇文章

订阅专栏

Private Sub Workbook_open() ' '--- Define variables. ' Dim xlsbook As Excel.Workbook Dim xlsbookx As Excel.Workbook Dim filen As String Dim strDate, strCust, strDateN, strCustN, strTMP As String Dim iRow, iCount, iSheet As Integer Dim iNewSheet As Boolean ' '--- Handle C:/TEMP/MIS/Report/TMP0047301.xls ' Application.ScreenUpdating = False ' Set xlsbook = Workbooks.Open(Filename:="C:/TEMP/MIS/Report/TMP0047301.xls") xlsbook.Save xlsbook.Close ' '--- Handle C:/TEMP/MIS/Report/P00473_Form.xls. ' Application.ScreenUpdating = False Set xlsbookx = Workbooks.Open(Filename:="C:/TEMP/MIS/Program/P00473A_Form.xls", UpdateLinks:="3") ' Set xlsbook = Workbooks.Open(Filename:="C:/TEMP/MIS/Report/TMP0047301.xls") ' iRow = 2 iCount = 0 iSheet = 1 iNewSheet = False strDate = Trim(Str(xlsbook.Sheets(1).Cells(iRow, 2).Value)) strCust = Trim(xlsbook.Sheets(1).Cells(iRow, 7).Value) strDateN = "0" strCustN = "0" Do While strCustN <> "" iNewSheet = False If (strDate = strDateN) And (strCust = strCustN) Then If iCount >= 12 Then 'iNewSheet = True 'iSheet = iSheet + 1 xlsbookx.Sheets(LastSheet).Rows(Trim(Str(20 + iCount * 3 - 1)) + ":" + Trim(Str(20 + iCount * 3 - 1))).Insert Shift:=xlDown xlsbookx.Sheets(LastSheet).Rows(Trim(Str(20 + iCount * 3 - 1)) + ":" + Trim(Str(20 + iCount * 3 - 1))).Insert Shift:=xlDown xlsbookx.Sheets(LastSheet).Rows(Trim(Str(20 + iCount * 3 - 1)) + ":" + Trim(Str(20 + iCount * 3 - 1))).Insert Shift:=xlDown End If Else iNewSheet = True iSheet = 1 End If If iNewSheet Then iNewSheet = False iCount = 0 Application.ScreenUpdating = False strDate = Trim(Str(xlsbook.Sheets(1).Cells(iRow, 2).Value)) strCust = Trim(xlsbook.Sheets(1).Cells(iRow, 7).Value) LastSheet = xlsbookx.Sheets.Count xlsbookx.Sheets("PE(China)").Copy After:=xlsbookx.Sheets(LastSheet) If iSheet = 1 Then strTMP = strCust + "-" + strDate Else strTMP = strCust + "-" + strDate + "-" + Trim(Str(iSheet)) End If LastSheet = xlsbookx.Sheets.Count xlsbookx.Sheets(LastSheet).Name = strTMP xlsbookx.Sheets(LastSheet).Select xlsbookx.Sheets(LastSheet).Cells(7, 8).Value = Mid(strDate, 1, 4) + "-" + Mid(strDate, 5, 2) + "-" + Mid(strDate, 7, 2) xlsbookx.Sheets(LastSheet).Cells(10, 8).Value = strCust End If xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 1).Value = xlsbook.Sheets(1).Cells(iRow, 14).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 2).Value = xlsbook.Sheets(1).Cells(iRow, 17).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 4).Value = xlsbook.Sheets(1).Cells(iRow, 4).Value + " " + xlsbook.Sheets(1).Cells(iRow, 5).Value + " " + xlsbook.Sheets(1).Cells(iRow, 6).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 8).Value = xlsbook.Sheets(1).Cells(iRow, 16).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 9).Value = xlsbook.Sheets(1).Cells(iRow, 15).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3, 10).Value = xlsbook.Sheets(1).Cells(iRow, 18).Value xlsbookx.Sheets(LastSheet).Cells(20 + iCount * 3 + 1, 4).Value = "PO#" + xlsbook.Sheets(1).Cells(iRow, 3).Value + " " + xlsbook.Sheets(1).Cells(iRow, 5).Value + " " + xlsbook.Sheets(1).Cells(iRow, 11).Value iRow = iRow + 1 iCount = iCount + 1 strDateN = Trim(Str(xlsbook.Sheets(1).Cells(iRow, 2).Value)) strCustN = Trim(xlsbook.Sheets(1).Cells(iRow, 7).Value) Loop ' '--- Delete The First Sheet. ' Application.DisplayAlerts = False xlsbookx.Sheets("PE(China)").Delete Application.DisplayAlerts = True ' '--- Save C:/TEMP/MIS/Report/P00473.xls. ' filen = "C:/TEMP/MIS/Report/P00473_" + Format(Date, "yyyymmdd") + Format(Time, "hhmmss") + ".xls" xlsbookx.SaveAs (filen) xlsbookx.Close Set xlsbookx = Nothing xlsbook.Close Set xlsbook = Nothing ' '--- Inform user. ' 'MsgBox ("请核对 " + filen) ' ' '--- Quit Application.Quit End Sub

源数据 TMP0047301

TMP0047301