问题描述
希望你能帮我把不同的部分放在一起。
我有两本工作簿,wkbPB(基础),wkbZLISTP(与 wkbPB 比较)。 两个工作簿都有两列包含文章编号。和标价。 我需要比较每个货号的标价。在 wkbPB 中,带有该商品编号的标价。在 wkbZLISTP 中。
- 第 1 条中有匹配项的地方。且标价差小于 0.04 删除 wkbPB 中的行。
- 第 1 条中有匹配项的地方。且标价差大于0.04wkbZLISTP的标价需要写在wkbPB标价旁边的一栏中。
- 如果商品编号中没有匹配项,则在 wkbPB 中以红色显示的标价旁边的附加列中会写入“MISSING”。
目前我正在使用包含查找对话框的 For Next 循环执行此任务。它可以解决问题,但最多需要 45 分钟才能完成。 现在我在互联网上搜索并通过似乎闪电般快速的数组进行了比较。 Example。
但是,我无法坚持如何根据我的目的自定义该代码,完全大脑冻结。 你能帮忙吗?
非常感谢!
Dim d As Long
For d = 2 To noOfRowsPB Step 1
If wkbPB.Worksheets(1).Cells(d,1).Value <> "" Then
Dim looking4 As String
looking4 = UCase(wkbPB.Worksheets(1).Cells(d,26).Value)
Dim ctrUPNRng As Range
Dim ctrUPNRow As Long
Set ctrUPNRng = wkbZLISTP.Worksheets(1).Cells.Find(looking4,After:=Range("A1"),LookIn:=xlFormulas,LookAt _
:=xlWhole,SearchOrder:=xlByRows,SearchDirection:=xlNext,MatchCase:=False,SearchFormat:=False)
If Not ctrUPNRng Is nothing Then
ctrUPNRow = ctrUPNRng.Row
If Abs(CSng(wkbPB.Worksheets(1).Cells(d,24).Value) - CSng(wkbZLISTP.Worksheets(1).Cells(ctrUPNRow,14).Value)) > 0.04 Then
wkbPB.Worksheets(1).Cells(d,27).Value = wkbZLISTP.Worksheets(1).Cells(ctrUPNRow,14).Value
Else
Rows(d).EntireRow.Delete Shift:=xlUp
d = d - 1
End If
Else
wkbPB.Worksheets(1).Cells(d,27).Value = "MISSING"
With wkbPB.Worksheets(1).Range("AA" & d).Font
.Color = -16776961
.TintAndShade = 0
End With
End If
Else
Exit For
End If
Next d
解决方法
花了一段时间,但我已经设法让它自己工作了!
我所需要的只是将数组的正确图片放入我的脑海中!这实际上非常简单:数组只不过是一个表。因此,您从工作表中获取数据范围并将该范围分配给数组!大功告成!
嗯,还有一些挑战需要克服,但有了这些基本的了解,我就成功了!
看看节省的时间:旧宏:33:43 分钟,新宏:7:31 分钟!
这就是现在的样子:
Dim d As Long
Dim PBArray As Variant
Dim ZLISTPArray As Variant
Dim f As Long
Dim rngPB As Range
Dim rngZLISTP As Range
Dim rowDel As Long
noOfRowsPB = wkbPB.Worksheets(1).Cells(Rows.Count,1).End(xlUp).Row
noOfRowsZLISTP = wkbZLISTP.Worksheets(1).Cells(Rows.Count,1).End(xlUp).Row
Set rngPB = wkbPB.Worksheets(1).Range(Cells(2,1),Cells(noOfRowsPB,26))
PBArray = rngPB
wkbZLISTP.Activate
Set rngZLISTP = wkbZLISTP.Worksheets(1).Range(Cells(2,Cells(noOfRowsZLISTP,19))
ZLISTPArray = rngZLISTP
rowDel = 0
For d = 1 To UBound(PBArray)
For f = 1 To UBound(ZLISTPArray)
'Can we find it?
If PBArray(d,26) = ZLISTPArray(f,19) Then
'Found it,now price comparison
If Abs(PBArray(d,24) - ZLISTPArray(f,14)) > 0.04 Then
'Price difference,we want to see it
wkbPB.Worksheets(1).Cells(d + 1 - rowDel,27).Value = wkbZLISTP.Worksheets(1).Cells(f + 1,14).Value
Exit For
Else
'No price difference,we can delete it
wkbPB.Worksheets(1).Rows(d + 1 - rowDel).EntireRow.Delete Shift:=xlUp
rowDel = rowDel + 1
Exit For
End If
ElseIf f = UBound(ZLISTPArray) Then
'Despite searching to the end,no findings,then we need to make that visible too
wkbPB.Worksheets(1).Cells(d + 1 - rowDel,27).Value = "MISSING"
With wkbPB.Worksheets(1).Range("AA" & d + 1 - rowDel).Font
.Color = -16776961
.TintAndShade = 0
End With
End If
Next f
Next d
也许有一天这也会对某人有所帮助!
享受吧!