有兩個表格，分別為“商品資訊”，“新增資訊”。其中兩個表A列是商品編碼，C列是商品儲位。如果同時滿足兩個條件相同，則認定此條資訊相同。現在需要如下宏計算：
按鈕1（計算）：計算出此表格A2:D1000，范圍內與表“商品資訊”中“商品編碼”和“儲位編碼”兩種條件同時一致的在E:E列后面輸入“清除”兩個字，否則就輸入今日日期。 同時在表“商品資訊”中如果“商品編碼”和“儲位編碼”與表“新增資訊”中的“商品編碼”和“儲位編碼”同時匹配上，輸入“保留”兩個字。否則輸入“清除”完成之后對兩個表同時對類別列進行升序排列。排列完成后將屬性列中為“清除”字樣行進行洗掉
按鈕2（清除）：對表“新增資訊”A2:E1000進行清除，同時對表“虛擬儲位資料”中“移入日期”列及“儲位”列進行升序排列
uj5u.com熱心網友回復：
誰能解答我的問題啊uj5u.com熱心網友回復：
...完成之后對兩個表同時對類別列進行升序排列。...請問這里說的類別是指什么?
uj5u.com熱心網友回復：
...對表“新增資訊”A2:E1000進行清除...請問是整個清空了,還是洗掉包含"清除"的行?
uj5u.com熱心網友回復：
寫好了,代碼如下:
Option Explicit
Sub 計算()
Dim dctProductInfos As Object
Set dctProductInfos = CreateObject("scripting.dictionary")
With Sheets("商品資訊")
Dim i As Long
For i = 2 To 1000
If .Range("A" & i).Value <> "" Then
Dim strKey As String
strKey = .Range("A" & i).Value & vbCrLf & .Range("C" & i).Value
Dim objRange As Range
Set objRange = .Range("A" & i & ":K" & i)
If dctProductInfos.exists(strKey) Then
dctProductInfos.Item(strKey).Add objRange
Else
Dim colInfos As Collection
Set colInfos = New Collection
colInfos.Add objRange
dctProductInfos.Add strKey, colInfos
End If
End If
Next
End With
Dim dctNewInfos As Object
Set dctNewInfos = CreateObject("scripting.dictionary")
With Sheets("新增資訊")
For i = 2 To 1000
If .Range("A" & i).Value <> "" Then
strKey = .Range("A" & i).Value & vbCrLf & .Range("C" & i).Value
Set objRange = .Range("A" & i & ":E" & i)
If dctNewInfos.exists(strKey) Then
dctNewInfos.Item(strKey).Add objRange
Else
Set colInfos = New Collection
colInfos.Add objRange
dctNewInfos.Add strKey, colInfos
End If
End If
Next
End With
Dim varKey As Variant
For Each varKey In dctNewInfos
Set colInfos = dctNewInfos.Item(varKey)
If dctProductInfos.exists(varKey) Then
For i = 1 To colInfos.Count
colInfos.Item(i).Item(5).Value = "清除"
Next
Else
For i = 1 To colInfos.Count
colInfos.Item(i).Item(5).Value = Format(Now, "yyyy/mm/dd")
Next
End If
Next
For Each varKey In dctProductInfos
Set colInfos = dctProductInfos.Item(varKey)
If dctNewInfos.exists(varKey) Then
For i = 1 To colInfos.Count
colInfos.Item(i).Item(11).Value = "保留"
Next
Else
For i = 1 To colInfos.Count
colInfos.Item(i).Item(11).Value = "清除"
Next
End If
Next
With Sheets("商品資訊")
For i = 1000 To 2 Step -1
If .Range("K" & i).Value = "清除" Then
.Range(i & ":" & i).Delete
End If
Next
End With
End Sub
Sub 清除()
With Sheets("新增資訊")
' 洗掉包含"清除"的行:
Dim i As Long
For i = 1000 To 2 Step -1
If .Range("E" & i).Value = "清除" Then
.Range(i & ":" & i).Delete
End If
Next
' 洗掉全部資料:
'.Range("A2:E1000").Clear
' 需要"虛擬儲位資料"表:
'.Range("A1:E1000").Sort Key1:=Range("A2"), Key2:=Range("C2"), Header:=xlYes
End With
End Sub
運行示例:
下載地址:
鏈接：https://pan.baidu.com/s/1c6NSAGkQlRr-5j0ws6gkNg
提取碼：5jmh
uj5u.com熱心網友回復：
可以考慮兩個表新建一個欄位將AC列連接起來，然后通過判斷這個新欄位是否相等再去做相應的處理。轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/25173.html
標籤：VBA