|
fghji 发表于 2013-2-1 10:08
D到H, E到I, F到J, G到K, H到L, I到M, J到N, K到O, L到P, M到Q,都是固定5列找重数
他的代码稍微改变一下就行啦
Sub test()
Dim arr, result(), l&, rgitem, arrrg
arrrg = Array("D15:H300", "E15:I300", "F15:J300", "G15:K300", "H15:L300", "I15:M300", _
"J15:N300", "K15:O300", "L15:P300", "M15:Q300", _
"N15:R300", "O15:S300", "P15:T300", "Q15:U300")
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
For Each rgitem In arrrg
arr = Range(rgitem)
For Each Item In arr
dic(Item) = dic(Item) + 1
Next
For Each Key In dic.Keys
If dic(Key) = 4 Then
l = l + 1
ReDim Preserve result(1 To l)
result(l) = "'" & Key
End If
Next
dic.RemoveAll
Next
Range("w:w").ClearContents
Range("w1").Resize(l) = WorksheetFunction.Transpose(result)
MsgBox "提取完成"
End Sub
|
|