按颜色组织

我遇到了一个问题，我有一个脚本感谢几个成员在这里让我直接从一个文件导入到工作簿。 用同样的脚本，我已经把红色的颜色和绿色的底色组织起来了。 我以为自己可以编写代码来使自己处于中间的黄色，但是它并没有考虑到黄色和红色之间的区别，尽pipe我认为我通过脚本确实使这种区别变得明显。

如果有人可以看看这个，告诉我哪里出错了，那将会非常受欢迎。

这是我现在得到的最终结果，黄色是导入后，表单btw的底部。

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

Zip文件

或这些文件在这里分开…

片

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 

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