0

由于某种原因，当此脚本导出到 PO 跟踪选项卡时，最后两行未格式化...我不知道为什么据我所知代码应该考虑到这一点。如果有人可以看看下面的代码并告诉我我需要在哪里调整它，我们将不胜感激。

Option Explicit

Sub PO_Tracking()

Dim wsPOD As Worksheet
Dim wsPOT As Worksheet
Dim wsPOA As Worksheet
Dim cel As Range
Dim lastrow As Long, i As Long, Er As Long

Set wsPOD = Sheets("PO Data")
Set wsPOT = Sheets("PO Tracking")
Set wsPOA = Sheets("PO Archive")

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

With wsPOD
    'first bring columns F:G up to match their line
    For Each cel In Intersect(.UsedRange, .UsedRange.Offset(5), .Columns(6))

        If cel = vbNullString And cel.Offset(, -2) <> vbNullString Then
            .Range(cel.Offset(1), cel.Offset(1, 1)).Copy cel
            cel.Offset(1).EntireRow.Delete
        End If

    Next

    'now fil columns A:D to match PO Date and PO#
    For Each cel In Intersect(.UsedRange, .UsedRange.Offset(5), .Columns(1))

        If cel = vbNullString And cel.Offset(, 5) <> vbNullString Then
            .Range(cel.Offset(-1), cel.Offset(-1, 3)).Copy cel
        End If
    Next
'Blow away rows that are useless
    lastrow = wsPOD.Range("A6").End(xlDown).Row
    wsPOD.Range("M5:P5").Copy wsPOD.Range("M6:P" & lastrow)
    Calculate

    With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("N"))
        .AutoFilter 1, "<>Different"
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("P"))
        .AutoFilter 1, "<>"
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    lastrow = wsPOD.Range("A6").End(xlDown).Row
    wsPOD.UsedRange.Copy Sheets.Add.Range("A1")


'Final Adjustments before transfering over to new sheet.
    With ActiveSheet
        .AutoFilterMode = False
        Intersect(.UsedRange, .Columns("A")).Cut .Range("Q1")
        Intersect(.UsedRange, .Columns("D")).Cut .Range("R1")
        Intersect(.UsedRange, .Columns("C")).Cut .Range("S1")
        Intersect(.UsedRange, .Columns("B")).Cut .Range("T1")
        Intersect(.UsedRange, .Columns("G")).Cut .Range("U1")
        Intersect(.UsedRange, .Columns("F")).Cut .Range("V1")
        Intersect(.UsedRange, .Range("Q:V")).Copy wsPOT.Cells(Rows.Count, "B").End(xlUp).Offset(1)
        .Delete
    End With

    lastrow = wsPOD.Cells(Rows.Count, "B").End(xlUp).Row
    wsPOT.Range("R1:X1").Copy
    wsPOT.Range("B3:H" & lastrow).PasteSpecial xlPasteFormats
    wsPOT.Range("N2:O2").Copy wsPOT.Range("N3:O" & lastrow)
    wsPOT.Range("P1:Q1").Copy wsPOT.Range("I3:J" & lastrow)
    wsPOT.Range("K3:K" & lastrow).Borders.Weight = xlThin
End With



Application.CutCopyMode = False

End Sub

这是excel表。

http://dl.dropbox.com/u/3327208/Excel/Last%20two%20rows.xlsm

4

1 回答 1

1

您是否逐行浏览了代码，以确切了解它对您的电子表格做了什么？到目前为止，这是了解代码失败原因的最佳方法，因为一旦运行它，您就会看到失败行。此外，这是从其他开发人员那里获得出色答案的最佳方式，因为如果您仍然不明白它为什么会中断，您可以查明您的问题，从而使我们更容易进行故障排除。

我逐步浏览了代码——因为我帮助构建了它！根据我的记忆，它甚至似乎没有做它应该做的事情。

于 2012-05-17T18:16:41.087 回答