数据更新。。。之前多次麻烦了星光版主感谢。

此用户被禁言

之前之次麻烦了星光版主。都不好意思了。所以重新发个帖子求助。。。麻烦各位老师再看一下。


更新后620.zip (18.96 KB, 下载次数: 4)

2018-6-20 20:27 上传

点击文件名下载附件

liulang0808

1. Sub 按钮1_Click()
   
2.     Dim rng As Range
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = [a1].CurrentRegion
   
5.     Application.ScreenUpdating = False
   
6.     For j = 2 To UBound(arr)
   
7.         If Len(arr(j, 2)) = 0 Then
   
8.             d(arr(j, 1) & arr(j, 4)) = j
   
9.         Else
   
10.             d(arr(j, 2)) = j
    
11.         End If
    
12.     Next j
    
13.    
    
14.     r = UBound(arr) + 1
    
15.     arr = Sheets("新2").UsedRange
    
16.     For j = 2 To UBound(arr)
    
17.         If Len(arr(j, 2)) = 0 Then
    
18.             If Not d.exists(arr(j, 1) & arr(j, 4)) Then
    
19.                 If rng Is Nothing Then
    
20.                     Set rng = Sheets("新2").Cells(j, 1).Resize(1, 4)
    
21.                 Else
    
22.                     Set rng = Union(rng, Sheets("新2").Cells(j, 1).Resize(1, 4))
    
23.                 End If
    
24.             End If
    
25.         Else
    
26.             If Not d.exists(arr(j, 2)) Then
    
27.                 If rng Is Nothing Then
    
28.                     Set rng = Sheets("新2").Cells(j, 1).Resize(1, 4)
    
29.                 Else
    
30.                     Set rng = Union(rng, Sheets("新2").Cells(j, 1).Resize(1, 4))
    
31.                 End If
    
32.             Else
    
33.                 Sheets("新2").Cells(j, 1).Resize(1, 4).Copy Cells(d(arr(j, 2)), 1)
    
34.             End If
    
35.         End If
    
36.     Next j
    
37.     If Not rng Is Nothing Then rng.Copy Cells(r, 1)
    
38.     Application.ScreenUpdating = True
    
39. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

此用户被禁言

liulang0808 发表于 2018-6-20 21:46
附件内容供参考。。。。。。

多谢老师。我用了你写的代码，改在我真实的数据中。。。发现导三个文件就报错。但是导入任意两个不会错。。查不出原因了。。老师再帮忙看一下。谢谢

导三个就报错.zip (87.04 KB, 下载次数: 5)

2018-6-21 11:24 上传

点击文件名下载附件

此用户被禁言

顶一下。。。

此用户被禁言

好像是rng不为空。但是又没有内容。所以才会导致出错。这个应该如何修改。。。请各位指教一下。谢谢

liulang0808

此用户被禁言 发表于 2018-6-21 11:24
多谢老师。我用了你写的代码，改在我真实的数据中。。。发现导三个文件就报错。但是导入任意两个不会错。 ...

楼主这次发的东西跟之前不一样啊
不是一个问题的

lsc900707

此用户被禁言 发表于 2018-6-21 11:24
多谢老师。我用了你写的代码，改在我真实的数据中。。。发现导三个文件就报错。但是导入任意两个不会错。 ...

这样的汇总数组就可以完成的！

此用户被禁言

lsc900707 发表于 2018-6-21 16:46
这样的汇总数组就可以完成的！

要保留格式。。。数组就不行。而且是更新。。下插入

此用户被禁言

liulang0808 发表于 2018-6-21 16:02
楼主这次发的东西跟之前不一样啊
不是一个问题的

我自己修改了一下。。。在后面加了一句  Set rng = Nothing
目前测试没发现问题，需要再多测试一下。