VBA逐步通过代码工作，button不
我能够通过macros，但button不能正常工作。 我想要做的只是格式的工作表安排在这个特定的顺序列：
vCOLs = Array("Purchase Order", "Document Number", "Invoice Date", _ "Invoice Number", "Business Unit", "Object", "Subsidiary", "G/L Date", _ "Period Number", "Fiscal Year", "Supplier", "Name", _ "Supplier Name/ Explanation", "Description", "Explanation -Remark-", _ "Amount") 这是我到目前为止的代码：
Dim a As Long, w As Long, x As Long, col As Long, lRow As Long Dim c As Long, vCOLs As Variant Dim vDELCOLs As Variant, vCOLNDX As Variant, N As Variant Dim sht As Range, ACell As Range, Rng As Range Dim wb1 As Workbook Dim ws As Worksheet Set wb1 = Workbooks("Sourcing KPI Spend Report Q3 2017.xlsm") Set sht = wb1.Sheets("Spend Report").UsedRange Set ws = ThisWorkbook.Sheets("Spend Report") Application.ScreenUpdating = False ws.Rows("1:6").Delete sht.AutoFilter Field:=1, Criteria1:="=" sht.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp) sht.AutoFilter sht.AutoFilter Field:=2, Criteria1:="=" sht.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp) sht.AutoFilter vDELCOLs = Array("Account Number", "Batch Type", "Batch Number", "Doc Type", _ "Company", "LT", "Transaction Currency", "Base Currency", "Work Order", _ "Subledger", "Subledger Type", "Transaction Originator") With Sheets("Spend Report") For a = LBound(vDELCOLs) To UBound(vDELCOLs) vCOLNDX = Application.Match(vDELCOLs(a), .Rows(1), 0) If Not IsError(vCOLNDX) Then .Columns(vCOLNDX).EntireColumn.Delete End If Next a End With ColCount = Sheets("Spend Report").Cells(1, Columns.Count).End(xlToLeft).Column sht.EntireColumn.Insert (ColCount)
这是它开始打破的地方
For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Purchase Order" Then ws.Cells(1, i).EntireColumn.Cut Range("A1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Document Number" Then ws.Cells(1, i).EntireColumn.Cut Range("B1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Invoice Date" Then ws.Cells(1, i).EntireColumn.Cut Range("C1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Invoice Number" Then ws.Cells(1, i).EntireColumn.Cut Range("D1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Business Unit" Then ws.Cells(1, i).EntireColumn.Cut Range("E1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Object" Then ws.Cells(1, i).EntireColumn.Cut Range("F1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Subsidiary" Then ws.Cells(1, i).EntireColumn.Cut Range("G1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "G/L Date" Then ws.Cells(1, i).EntireColumn.Cut Range("H1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Period Number" Then ws.Cells(1, i).EntireColumn.Cut Range("I1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Fiscal Year" Then ws.Cells(1, i).EntireColumn.Cut Range("J1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Supplier" Then ws.Cells(1, i).EntireColumn.Cut Range("K1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Name" Then ws.Cells(1, i).EntireColumn.Cut Range("L1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Supplier Name/ Explanation" Then ws.Cells(1, i).EntireColumn.Cut Range("M1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Description" Then ws.Cells(1, i).EntireColumn.Cut Range("N1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Explanation -Remark-" Then ws.Cells(1, i).EntireColumn.Cut Range("O1").Activate ws.Paste End If Next For i = 35 To 1 Step -1 If ws.Cells(1, i) = "Amount" Then ws.Cells(1, i).EntireColumn.Cut Range("P1").Activate ws.Paste End If Next Cells.EntireColumn.AutoFit For i = 17 To 1 Step -1 If Cells(1, i) = "Purchase Order" Then Cells(1, i).EntireColumn.Hidden = True End If Next For i = 17 To 1 Step -1 If Cells(1, i) = "Document Number" Then Cells(1, i).EntireColumn.Hidden = True End If Next For i = 17 To 1 Step -1 If Cells(1, i) = "Invoice Date" Then Cells(1, i).EntireColumn.Hidden = True End If Next For i = 17 To 1 Step -1 If Cells(1, i) = "Invoice Number" Then Cells(1, i).EntireColumn.Hidden = True End If Next ' vCOLs = Array("Purchase Order", "Document Number", "Invoice Date", _ "Invoice Number", "Business Unit", "Object", "Subsidiary", "G/L Date", _ "Period Number", "Fiscal Year", "Supplier", "Name", _ "Supplier Name/ Explanation", "Description", "Explanation -Remark-", _ "Amount") Application.ScreenUpdating = True End Sub
试试这个：
Sub tgr() Dim wb As Workbook Dim Source As Worksheet Dim DestWS As Worksheet Dim DestCell As Range Dim FoundHeader As Range Dim ColHeaders As Variant Dim ColHeader As Variant Const HeaderRow = 1 'Note this is the header row after the first 6 rows are deleted Const SheetName As String = "Spend Report" 'Typically you want macros run on the active workbook Set wb = ActiveWorkbook 'If this macro is not being run on the active workbook, you can specify the workbook to run it on 'To do so, uncomment the below line and comment out the ActiveWorkbook line above 'Set wb = Workbooks("Sourcing KPI Spend Report Q3 2017.xlsm") Set Source = wb.Sheets(SheetName) ColHeaders = Array("Purchase Order", "Document Number", "Invoice Date", _ "Invoice Number", "Business Unit", "Object", "Subsidiary", "G/L Date", _ "Period Number", "Fiscal Year", "Supplier", "Name", _ "Supplier Name/ Explanation", "Description", "Explanation -Remark-", _ "Amount") 'Delete first 6 rows Source.Range("1:6").EntireRow.Delete 'Delete rows where there are blank cells in column A or B Source.UsedRange.AutoFilter 1, "=" Source.UsedRange.Offset(1).EntireRow.Delete Source.UsedRange.AutoFilter Source.UsedRange.AutoFilter 2, "=" Source.UsedRange.Offset(1).EntireRow.Delete Source.UsedRange.AutoFilter 'Create new worksheet that will contain the columns in desired order Set DestWS = wb.Sheets.Add(After:=Source) Set DestCell = DestWS.Range("A1") 'Cut/paste the columns in the proper order to the new sheet For Each ColHeader In ColHeaders Set FoundHeader = Source.Rows(HeaderRow).Find(ColHeader, Source.Cells(HeaderRow, Source.Columns.Count), xlValues, xlWhole) If Not FoundHeader Is Nothing Then FoundHeader.EntireColumn.Cut DestCell Set DestCell = DestWS.Cells(1, DestWS.Columns.Count).End(xlToLeft).Offset(, 1) End If Next ColHeader 'Delete the original which will no longer be used Application.DisplayAlerts = False Source.Delete Application.DisplayAlerts = True 'Rename the destination sheet to the proper sheet name DestWS.Name = SheetName End Sub