大神们，求救。WIN系统下运行测试成功，MAC版本系统下运行错误。

gl0807 · 发表于 2018-7-17 17:48

本帖最后由 gl0807 于 2018-7-17 22:16 编辑

按照D4-D48中的内容（品牌名称）筛选同A4单元格相同的品牌名称的重复值，并在E4单元格显示；
谢谢。。。。
想用公式函数等得出E4数值，条件是：
按照D4-D48中的内容（品牌名称）筛选同A4单元格相同的品牌名称的重复值，并在E4单元格显示；

chxw68 · 发表于 2018-7-17 18:17

Sub test()
Dim r%, i%
Dim arr, brr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Worksheets("7.15")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("e4:e" & r - 1).ClearContents
arr = .Range("a4:e" & r - 1)
For i = 1 To UBound(arr)
If Len(arr(i, 4)) <> 0 Then
xm = Split(arr(i, 4), "、")
For j = 0 To UBound(xm)
d(xm(j)) = d(xm(j)) + 1
Next
End If
Next
For i = 1 To UBound(arr)
If d.exists(arr(i, 1)) Then
arr(i, 5) = d(arr(i, 1))
End If
Next
.Range("a4:e" & r - 1) = arr
End With
End Sub

复制代码

chxw68 · 发表于 2018-7-17 18:17

详见附件。

chis3 · 发表于 2018-7-17 18:55

Sub test()
Dim dic As Object: Set dic = CreateObject("scripting.dictionary")
Dim arr, i As Integer, brr(1 To 1000, 1 To 1), j As Integer
arr = Range([a4], Cells(Rows.Count, 4).End(xlUp))
For i = 1 To UBound(arr)
      If Not dic.exists(arr(i, 1)) Then
         dic(arr(i, 1)) = i
      End If
Next i
For i = 0 To dic.Count - 1
      For j = 1 To UBound(arr)
         If InStr(1, arr(j, 4), dic.keys()(i), vbTextCompare) > 0 Then
            brr(dic(arr(i + 1, 1)), 1) = brr(dic(arr(i + 1, 1)), 1) + 1
         End If
      Next j
Next i
[d4].Resize(dic.Count, 1) = brr
End Sub

gl0807 · 发表于 2018-7-17 20:47

chxw68 发表于 2018-7-17 18:17
详见附件。

运行出现出个提示

chxw68 · 发表于 2018-7-17 20:50

gl0807 发表于 2018-7-17 20:47
运行出现出个提示

你把出错文件发上来。

chxw68 · 发表于 2018-7-17 20:51

gl0807 发表于 2018-7-17 20:47
运行出现出个提示

你用的是不是WPS？

gl0807 · 发表于 2018-7-17 21:03

本帖最后由 gl0807 于 2018-7-17 21:04 编辑

chxw68 发表于 2018-7-17 20:51
你用的是不是WPS？

就是下载您那个附件。运行就出现了。
我的MAC版的office365运行调试：

chxw68 · 发表于 2018-7-17 21:05

gl0807 发表于 2018-7-17 21:03
就是下载您那个附件。运行就出现了。
我的MAC版的office365

这个只能保证在WIN+OFFICE系统下运行，在MAC系统下可能运行不了。

gl0807 · 发表于 2018-7-17 21:09

chxw68 发表于 2018-7-17 21:05
这个只能保证在WIN+OFFICE系统下运行，在MAC系统下可能运行不了。

哦。。那没有别的办法了吗？

		自动登录	找回密码
密码			免费注册

[求助] 大神们，求救。WIN系统下运行测试成功，MAC版本系统下运行错误。