Question

我可以单步执行宏但按钮无法正常工作。我尝试做的只是格式化工作表以按特定顺序排列列：

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

Answer 1

尝试一下：

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

VBA单步执行代码工作，按钮没有

1 个答案: