我遇到了一个问题，我有一个脚本感谢这里的几个成员允许我直接从文件导入到工作簿中。使用相同的脚本，我已经结合了按顶部红色和底部绿色进行组织的能力。我想我可以编写代码来让黄色出现在我自己的中间，但它并没有考虑到黄色和红色之间的区别，尽管我认为我确实通过脚本使这种区别很明显。
如果有人可以看看这个并告诉我哪里出错了，那将不胜感激。
这就是我现在得到的最终结果，在导入后，黄色位于表单的底部。
出于某种原因，代码读取不正确，因此还附上了指向工作表的链接，其中包含要导入的添加文件。
或者文件在这里分开......
这是我的代码：
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