[已解决]求助：当相同型号与名称出现一样的编号出现提示

wgxfhi11

当相同型号与名称出现一样的编号出现提示

最佳答案

月排行榜 / 总排行榜

爱疯

2011-1-11 16:43

1. 
   
2. Sub pd()
   
3.     Dim d As Object
   
4.     Dim sj, tmp
   
5.     Dim i, j
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     With Sheets("Sheet1")
   
8.         sj = .Range("d2:d" & .Range("d2").End(xlDown).Row).Value
   
9.     End With
   
10.     For i = 1 To UBound(sj)
    
11.         tmp = VBA.Split(sj(i, 1), "/")
    
12.         For j = 0 To UBound(tmp)
    
13.             If d.exists(tmp(j)) Then
    
14.                 '提示
    
15.                 MsgBox "D" & i + 1 & "的" & tmp(j) & "和" & "D" & d(tmp(j)) & "相同"
    
16.                 End
    
17.             Else
    
18.                 d(tmp(j)) = i + 1 & "的" & tmp(j)
    
19.             End If
    
20.         Next j
    
21.     Next i
    
22. End Sub

复制代码

Book1b.rar (13.78 KB, 下载次数: 24)

2011-1-11 16:43 上传

点击文件名下载附件
这样可以吗

跳转到最佳答案楼层

wgxfhi11

O(∩_∩)O哈哈~，沙发是我的啦
wgxfhi11 于 2011-1-11 15:55 使用 抢沙发 抢夺本帖沙发

wgxfhi11

请各位帮帮忙

爱疯

1. 
   
2. Sub pd()
   
3.     Dim d As Object
   
4.     Dim sj, tmp
   
5.     Dim i, j
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     With Sheets("Sheet1")
   
8.         sj = .Range("d2:d" & .Range("d2").End(xlDown).Row).Value
   
9.     End With
   
10.     For i = 1 To UBound(sj)
    
11.         tmp = VBA.Split(sj(i, 1), "/")
    
12.         For j = 0 To UBound(tmp)
    
13.             If d.exists(tmp(j)) Then
    
14.                 '提示
    
15.                 MsgBox "D" & i + 1 & "的" & tmp(j) & "和" & "D" & d(tmp(j)) & "相同"
    
16.                 End
    
17.             Else
    
18.                 d(tmp(j)) = i + 1 & "的" & tmp(j)
    
19.             End If
    
20.         Next j
    
21.     Next i
    
22. End Sub

复制代码

Book1b.rar (13.78 KB, 下载次数: 24)

2011-1-11 16:43 上传

点击文件名下载附件
这样可以吗

sunjing-zxl

学习最佳！！！