[字典] 配对与覆制

chenbiao2012 · 发表于 2015-5-19 23:00

是提示下标越界？

chenbiao2012 · 发表于 2015-5-19 23:02

估计你实际的数据和你刚上传的附件差异造成的，上传的附件经测试没有问题

On_fire · 发表于 2015-5-19 23:14

chenbiao2012 发表于 2015-5-19 23:02
估计你实际的数据和你刚上传的附件差异造成的，上传的附件经测试没有问题

是的, 老师, 你是对的

有几个, 源数据,
由左到右, A至N列, 共14列
由上到下, 约2 -6W多行

liulang0808 · 发表于 2015-5-20 08:12

On_fire 发表于 2015-5-19 21:15
非常谢谢老师的热心帮忙, 可惜当数据多的时候, 效果有点不一样!

请问能改用[字典], 不用数组吗?

b，c两列的需求是一致的
以b列为例，先把b列数据读入字典，for循环，然后再用for循环遍历j列，查找。这样能减少遍历次数

On_fire · 发表于 2015-5-20 11:18

liulang0808 发表于 2015-5-20 08:12
b，c两列的需求是一致的
以b列为例，先把b列数据读入字典，for循环，然后再用for循环遍历j列，查找。这 ...

谢谢老师!

因我实在是太菜鸟了, 请问可以帮忙写代码吗?

改天再努力向各位大神学习

liulang0808 · 发表于 2015-5-20 12:06

Sub 按钮1_Click()
Application.ScreenUpdating = False
Dim rnb As Range, rnc As Range
Set d = CreateObject("scripting.dictionary")
Sheets("a").Select
For j = 1 To Cells(Rows.Count, 2).End(3).Row
      If Len(Cells(j, 2)) > 0 Then
         d(Cells(j, 2).Value) = ""
'          For i = 1 To Cells(Rows.Count, "j").End(3).Row
'             If Cells(j, 2) = Cells(i, "j") Then
'                   If rnb Is Nothing Then
'                      Set rnb = Cells(i, 1)
'                   Else
'                      Set rnb = Union(rnb, Cells(i, 1))
'                   End If
'             End If
'          Next i
      End If
Next j
For i = 1 To Cells(Rows.Count, "j").End(3).Row
      If d.exists(Cells(i, "j").Value) Then
         If rnb Is Nothing Then
            Set rnb = Cells(i, 1)
         Else
            Set rnb = Union(rnb, Cells(i, 1))
         End If
      End If
Next i
If Not rnb Is Nothing Then rnb.EntireRow.Copy Sheets("b").Cells(1, 1)
For j = 1 To Cells(Rows.Count, 3).End(3).Row
      If Len(Cells(j, 3)) > 0 Then
         For i = 1 To Cells(Rows.Count, "k").End(3).Row
            If Cells(j, 3) = Cells(i, "k") Then
                  If rnc Is Nothing Then
                     Set rnc = Cells(i, 1)
                  Else
                     Set rnc = Union(rnc, Cells(i, 1))
                  End If
            End If
         Next i
      End If
Next j
If Not rnc Is Nothing Then rnc.EntireRow.Copy Sheets("c").Cells(1, 1)
Application.ScreenUpdating = True
End Sub

liulang0808 · 发表于 2015-5-20 12:07

做了局部修改，可以对比一下之前的

On_fire · 发表于 2015-5-20 12:31

liulang0808 发表于 2015-5-20 12:07
做了局部修改，可以对比一下之前的

谢谢老师, 还是有问题!

我发现 [A列, 有资料的格的那一行] 才有会覆制, 很奇怪?

liulang0808 · 发表于 2015-5-20 12:50

On_fire 发表于 2015-5-20 12:31
谢谢老师, 还是有问题!

我发现 [A列, 有资料的格的那一行] 才有会覆制, 很奇怪?

没有明白是什么意思的

On_fire · 发表于 2015-5-20 13:06

本帖最后由 On_fire 于 2015-5-20 23:18 编辑

(A1)格內有资料，就可以。(A2）格內沒內容，就不可以？

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

[求助] [字典] 配对与覆制