vba 如何用数组把新数据导入已有的数据库

chenwendong

我经常需要把最新的数据更新到已有的数据中。最新的数据经过编辑后，如果有编号的，说明是要更新的数据（原有数据已有），没有编号的是新增的数据。请问如何用数组的方式实现？如果有更快的方式也可以。我现在用的是用程序逐条读取Excel的方式，稍微多点数据，效率就很慢，电脑还容易卡。
示例如下
1、需要更新的数据（跟新的数量不确定，可能4条，也可能几十上百条），每一条根据编号，把更新数据覆盖和已有数据编号相同的数据

2、更新到已有的数据表，直接导入到已有数据，并自动添加编号

详见示例文件，请各位大神帮忙。我用数组的时候，老是出错，但是逐条读取的时候又效率太低。

3190496160

字典记录已有数据编号，然后匹配，能匹配则更新，不匹配则写入

3190496160

Sub test()
ar = Sheets("已有").[a1].CurrentRegion
xh = Sheets("已有").Cells(Rows.Count, 1).End(xlUp)
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        d(Trim(ar(i, 1))) = i
    End If
Next i
br = Sheets("原始").[a1].CurrentRegion
ReDim cr(1 To UBound(br), 1 To UBound(br, 2))
For i = 2 To UBound(br)
    If Trim(br(i, 1)) <> "" Then
        m = d(Trim(br(i, 1)))
        If m <> "" Then
            For j = 1 To UBound(br, 2)
                ar(m, j) = br(i, j)
            Next j
        End If
    End If
    If Trim(br(i, 1)) = "" Then
        n = n + 1
        xh = xh + 1
        cr(n, 1) = xh
        For j = 2 To UBound(br, 2)
            cr(n, j) = br(i, j)
        Next j
        
    End If
Next i
Sheets("已有").[a1].CurrentRegion = ar
r = Sheets("已有").Cells(Rows.Count, 1).End(xlUp).Row + 1
If n <> "" Then
    Sheets("已有").Cells(r, 1).Resize(n, UBound(cr, 2)) = cr
End If

End Sub

3190496160

示例.rar (14.7 KB, 下载次数: 21)

2020-6-3 15:08 上传

点击文件名下载附件

chenwendong

3190496160 发表于 2020-6-3 15:06
Sub test()
ar = Sheets("已有").[a1].CurrentRegion
xh = Sheets("已有").Cells(Rows.Count, 1).End(xlU ...

谢谢大神，帮我大忙了，比直接读取单元格进行判断高效了很多。

chenwendong

3190496160 发表于 2020-6-3 15:08

谢谢大神，效率很高，谢谢，谢谢

车厘子的red

看这个表有一点楼主我有点疑惑没看懂，就是“原始”表里的编号是你自己添加的吗？你原始表里的新增数据没有编号，但是你要在“已有”数据中自动添加编号，那么“原始”表里前面的数据编号到底根据什么编写的呢

kokokeke001

1. Sub test()
   
2.     ar = Sheets("已有").[a1].CurrentRegion
   
3.     xh = Sheets("已有").Cells(Rows.Count, 1).End(xlUp)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For i = 2 To UBound(ar)
   
6.         If Trim(ar(i, 1)) <> "" Then 'Trim函数删除给定输入字符串的前导空格和尾随空格。
   
7.             d(Trim(ar(i, 1))) = i '字典非空a列i行(a列编号即用于判断新增还是更新的依据)
   
8.         End If
   
9.     Next i
   
10.     br = Sheets("原始").[a1].CurrentRegion
    
11.     '[a1].CurrentRegion由a1向四周找单元格，遇到整空行空列停止，的范围(不包含遇到的空行列)
    
12.     'aa=[a1].CurrentRegion
    
13.     'UBound(aa) 取范围的最大值，参数1为行(默认可省略，参数2为列)
    
14.     'MsgBox UBound(br) & Chr(13) & UBound(br, 2)
    
15.     ReDim cr(1 To UBound(br), 1 To UBound(br, 2))
    
16.     '这里cr是个数组(很可能猜错)表示每个br范围内单元格的行列(的值？)。
    
17.     For i = 2 To UBound(br)
    
18.         If Trim(br(i, 1)) <> "" Then
    
19.             m = d(Trim(br(i, 1))) '从字典d里按原始表行取a列数据(编号),不为空时
    
20.             If m <> "" Then
    
21.                 For j = 1 To UBound(br, 2) '从表原始向表已有赋值,
    
22.                     ar(m, j) = br(i, j)  'm是已有表的行，i是原始表内需要更新数据的行，j相同的列
    
23.                 Next j
    
24.             End If
    
25.         End If
    
26. '以上把需要更新的数据放到ar里面了。
    
27.         If Trim(br(i, 1)) = "" Then  '(编号)为空时，需要新增行
    
28.             n = n + 1 'n第一次用=1,每次+1
    
29.             xh = xh + 1 '编号+1
    
30.             cr(n, 1) = xh 'n,1就是n行1列,cr(n,1)就是这个单元格的值，新增数据的1行1列单元格的值等于xh(原来的最大编号)+1
    
31.             For j = 2 To UBound(br, 2)
    
32.                 cr(n, j) = br(i, j)  '这里赋值和上面一样
    
33.             Next j
    
34.         End If
    
35.     Next i
    
36.     Sheets("已有").[a1].CurrentRegion = ar '这里更新数据
    
37.     r = Sheets("已有").Cells(Rows.Count, 1).End(xlUp).Row + 1  '这里r用来过渡一个新行
    
38.     If n <> "" Then
    
39.         Sheets("已有").Cells(r, 1).Resize(n, UBound(cr, 2)) = cr '这里新增数据'把cells().resize()代替range使变量更简单的参与。
    
40.     End If
    
41. End Sub
    
42. 
    

复制代码

学习了。看了好久，越发觉得优雅。
ar(3,1)可以同时传递行、列、行列(单元格)的值，而且还是个范围，要好好学习数组了。
这是个数组吧。
一直都只会用cells，觉得比range好用。觉得变量好参与，现在看来要升级一下了。