Question

我遇到了一个问题，我有一个脚本，感谢这里的几个成员允许我直接从文件导入到工作簿中。使用相同的脚本，我已经将顶部的红色和绿色的底部组织起来。我以为我可以编写代码来使黄色自己在中间，但它并没有考虑到黄色和红色之间的区别，尽管我认为我确实通过脚本做出了明显的区别。

如果有人能看到这个并告诉我哪里出错了，那将会非常适合。

这是我现在获得的最终结果，导入后黄色位于工作表底部。

enter image description here

由于某种原因，代码读取权限不正确，因此附件也是工作表的链接，添加了要导入的文件。

Zip File

或文件分开在这里......

Sheet

CSV

这是我的代码：

Option Explicit

Sub Update_POT()

Dim wsPOD As Worksheet
Dim wsPOT As Worksheet
Dim wsPOA As Worksheet
Dim cel As Range
Dim lastrow As Long, fstcell As Long, i As Long, Er As Long, lstCol As Long, lstRow As Long, strFile As String

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
        .Columns("A:AB").ClearContents
        .Range("Y1").Formula = "=COUNTIFS('PO Tracking'!$D:$D,$C1,'PO Tracking'!$C:$C,$D1,'PO Tracking'!$F:$F,$G1)"
        .Range("Z1").Formula = "=IF($M1,"""",""Different"")"
        .Range("AA1").Formula = "=IF(ISBLANK($C1),0,1)"
        .Range("AB1").Formula = "=IF($O1,""Full"","""")"
    End With

    strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please selec text file...")

    With wsPOD.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=wsPOD.Range("A1"))
     .TextFileParseType = xlDelimited
     .TextFileCommaDelimiter = True
     .Refresh
    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
        lastrow = wsPOD.Cells(Rows.Count, "J").End(xlUp).Row
        fstcell = wsPOD.Cells(Rows.Count, "N").End(xlUp).Row
        wsPOD.Range("Y1:AB1").Copy wsPOD.Range("M" & fstcell & ":P" & lastrow)
        wsPOD.Range("M:P").Calculate
    End With

        With Intersect(wsPOD.UsedRange, wsPOD.Columns("P"))
        .AutoFilter 1, "<>Full"
        With Intersect(.Offset(2).EntireRow, .Parent.Range("A:P"))
            .EntireRow.Delete
        End With
        .AutoFilter
    End With

    With Intersect(wsPOD.UsedRange, wsPOD.Columns("N"))
        .AutoFilter 1, "<>Different"
        With Intersect(.Offset(2).EntireRow, .Parent.Range("A:P"))
            .EntireRow.Delete
        End With
        .AutoFilter
    End With

    'Final Adjustments before transfering over to PO Tracking.
    With wsPOD
        .AutoFilterMode = False
        lastrow = wsPOD.Cells(Rows.Count, "A").End(xlUp).Row
        Intersect(.UsedRange, .Range("A4:A" & lastrow)).Cut .Range("Q3")
        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")
     End With

    With wsPOD
        wsPOD.Columns("A:P").ClearContents
        lastrow = wsPOD.Cells(Rows.Count, "Q").End(xlUp).Row
        wsPOD.Range("Q3:V" & lastrow).Copy wsPOT.Cells(Rows.Count, "B").End(xlUp).Offset(1)
    End With
    'Format PO Tracking

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

        .Sort.SortFields.Clear

    'Sort PO Tracking

    'Sort Reds
        .Sort.SortFields.Add(.Range("J3:J" & lastrow), _
        xlSortOnIcon, xlAscending, , xlSortNormal).SetIcon Icon:=ActiveWorkbook. _
        IconSets(4).Item(1)

        .Sort.SortFields.Add Key:=Range( _
        "J3:J30" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal

    'Sort Yellows
        .Sort.SortFields.Add(.Range("I3:I" & lastrow), _
        xlSortOnIcon, xlAscending, , xlSortNormal).SetIcon Icon:=ActiveWorkbook. _
        IconSets(4).Item(2)

        .Sort.SortFields.Add Key:=Range( _
        "I3:I" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal

    'Sort Greens
        .Sort.SortFields.Add(.Range("I3:I" & lastrow), _
        xlSortOnIcon, xlAscending, , xlSortNormal).SetIcon Icon:=ActiveWorkbook. _
        IconSets(4).Item(3)

        .Sort.SortFields.Add Key:=Range( _
        "I3:I" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal

        With .Sort
            .SetRange wsPOT.Range("B2:K" & lastrow)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With


    With wsPOD
        wsPOD.Columns("Q:X").ClearContents
        wsPOD.Cells(1, 25).Value = "=COUNTIFS('PO Tracking'!$D:$D,$C1,'PO Tracking'!$C:$C,$D1,'PO Tracking'!$F:$F,$G1)"
        wsPOD.Cells(1, 27).Value = "=IF(ISBLANK($C1),0,1)"
        wsPOD.Range("Y1:AB1").Copy wsPOD.Range("M5:P5")
    End With

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
         .Calculation = xlCalculationAutomatic
    End With

End Sub

Answer 1

您必须删除该行

    .Sort.SortFields.Add Key:=Range( _
    "I3:I" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortNormal

在

    'Sort Yellows
    .Sort.SortFields.Add(.Range("I3:I" & lastrow), _
    xlSortOnIcon, xlAscending, , xlSortNormal).SetIcon Icon:=ActiveWorkbook. _
    IconSets(4).Item(2)

    .Sort.SortFields.Add Key:=Range( _
    "I3:I" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortNormal

同一列中的黄色和绿色不能具有相同的重复排序条件。删除该行，然后重试。

按颜色组织

1 个答案: