[已解决]请高手帮助

喜欢电子表格 · 发表于 2012-7-27 08:58

请高手解答.zip (11.44 KB, 下载次数: 50)

suye1010 · 发表于 2012-7-27 11:42

本帖最后由 suye1010 于 2012-7-27 11:43 编辑

Sub test()
Dim i, j, k, l, d
Set d = CreateObject("scripting.dictionary")
For i = 9 To Application.InputBox("请选择数据区域", "数据源", , , , , , 8).Rows.Count
For k = i - 1 To 1 Step -1
For l = 6 To 1 Step -1
If d.Count < 4 Then
If Not d.exists(Cells(k, l).Value) And Cells(k, l) <> "" Then d(Cells(k, l).Value) = Cells(k, l).Value
Else
Exit For
End If
Next l
Next k
For j = 1 To 6
If Cells(i, j) <> "" And Not d.exists(Cells(i, j).Value) Then Cells(i, j).Interior.ColorIndex = 4
Next j
d.RemoveAll
Next i
End Sub

复制代码

喜欢电子表格 · 发表于 2012-7-27 17:10

suye1010 发表于 2012-7-27 11:42

非常感谢你的帮助，不管对不对，也是由衷感谢，但我没有遇到这个情况，请你告诉我具体操作方法，以便验证，不好意思，我的知识贫乏。

suye1010 · 发表于 2012-7-27 20:50

喜欢电子表格发表于 2012-7-27 17:10
非常感谢你的帮助，不管对不对，也是由衷感谢，但我没有遇到这个情况，请你告诉我具体操作方法，以便验证 ...

请高手解答.zip (19.48 KB, 下载次数: 7)

喜欢电子表格 · 发表于 2012-7-30 12:47

本帖最后由喜欢电子表格于 2012-7-30 12:52 编辑

suye1010 发表于 2012-7-27 20:50
看附件吧……

这几天忙于其他，没有顾上看版块，suye1010老师，谢谢你的解答，结果非常正确，再次表示感谢，现在，有个问题需要劳驾：把你的内容照搬下来，我自己能不能复制代码这个过程，这个过程叫什么名称，是不是平常说的vba什么的?

喜欢电子表格 · 发表于 2012-7-30 15:22

suye1010 发表于 2012-7-27 20:50
看附件吧……

请高手解答1.zip (41.28 KB, 下载次数: 1)

suye1010 · 发表于 2012-7-30 16:02

喜欢电子表格发表于 2012-7-30 15:22
请你再次帮忙修改一下，非常感谢老师的帮助。

Sub test()
Dim i, j, k, l, d
Set d = CreateObject("scripting.dictionary")
For i = 9 To Application.InputBox("请选择待处理数据区域，从第一行开始到待分析数据末尾", "数据源", , , , , , 8).Rows.Count
For k = i - 1 To 1 Step -1
If d.Count < 4 Then
For l = 6 To 1 Step -1
If Not d.exists(Cells(k, l).Value) And Cells(k, l) <> "" Then d(Cells(k, l).Value) = Cells(k, l).Value
Next l
Else
Exit For
End If
Next k
For j = 1 To 6
If Cells(i, j) <> "" And Not d.exists(Cells(i, j).Value) Then Cells(i, j).Interior.ColorIndex = 4
Next j
d.RemoveAll
Next i
End Sub

复制代码

请高手解答1.zip (41.33 KB, 下载次数: 7)

喜欢电子表格 · 发表于 2012-7-30 17:05

suye1010 发表于 2012-7-30 16:02

再一次表示敬意--------------------------------------------------------

喜欢电子表格 · 发表于 2012-8-2 18:12

suye1010 发表于 2012-7-30 16:02

请老师修改.zip (37.79 KB, 下载次数: 1)

suye1010 · 发表于 2012-8-3 09:41

Sub test()
Dim i, j, k, l, d, rng As Range
Set rng = Application.InputBox("请选择待处理数据区域", "数据源", , , , , , 8)
If rng Is Nothing Then Exit Sub
rng.Interior.ColorIndex = 0
Set d = CreateObject("scripting.dictionary")
For i = rng.Row To rng.Rows.Count + rng.Row - 1
For k = i - 1 To 1 Step -1
If d.Count < 4 Then
For l = 6 To 1 Step -1
If Not d.exists(Cells(k, l).Value) And Cells(k, l) <> 0 Then d(Cells(k, l).Value) = Cells(k, l).Value
Next l
Else
Exit For
End If
Next k
For j = 1 To 6
If Cells(i, j) <> 0 And Not d.exists(Cells(i, j).Value) Then Cells(i, j).Interior.ColorIndex = 4
Next j
d.RemoveAll
Next i
End Sub

复制代码

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