[已解决]关于添加数据，详情请看附件~谢谢了。

likeblue

详情请下载附件。谢谢了
要实现的功能是：在原表的基础上，把另外一张表的数据 自动添加到原表中。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-2-23 05:24

1. Dim s&
   
2. Sub Macro1()
   
3. Dim c As Range, arr, i&, x&
   
4. s = s + 1
   
5. If s > 1 Then Exit Sub
   
6. arr = Range("g3").CurrentRegion
   
7. For i = 2 To UBound(arr)
   
8.     Set c = Range("b3").CurrentRegion.Find(arr(i, 1), searchdirection:=xlPrevious)
   
9.     If Not c Is Nothing Then
   
10.         x = c.Row + 1
    
11.         Range("b" & x).Resize(1, 3).Insert Shift:=xlDown
    
12.     Else
    
13.         x = Cells(Rows.Count, 2).End(xlUp).Row + 1
    
14.     End If
    
15.     Cells(x, 2) = arr(i, 1)
    
16.     Cells(x, 4) = arr(i, 2)
    
17. Next
    
18. End Sub
    

复制代码

跳转到最佳答案楼层

dsmch

1. Dim s&
   
2. Sub Macro1()
   
3. Dim c As Range, arr, i&, x&
   
4. s = s + 1
   
5. If s > 1 Then Exit Sub
   
6. arr = Range("g3").CurrentRegion
   
7. For i = 2 To UBound(arr)
   
8.     Set c = Range("b3").CurrentRegion.Find(arr(i, 1), searchdirection:=xlPrevious)
   
9.     If Not c Is Nothing Then
   
10.         x = c.Row + 1
    
11.         Range("b" & x).Resize(1, 3).Insert Shift:=xlDown
    
12.     Else
    
13.         x = Cells(Rows.Count, 2).End(xlUp).Row + 1
    
14.     End If
    
15.     Cells(x, 2) = arr(i, 1)
    
16.     Cells(x, 4) = arr(i, 2)
    
17. Next
    
18. End Sub
    

复制代码

dsmch

………………

likeblue

dsmch 发表于 2014-2-23 05:26
………………

非常感谢~是我想要的结果！谢谢了，我先研究一下你编的

likeblue

dsmch 发表于 2014-2-23 05:26
………………

这位朋友，能不能帮忙写个 注释？

dim S& 后面加个&是干啥用？

dsmch

1. Dim s&
   
2. Sub Macro1()
   
3. '&为长整型变量简写
   
4. Dim c As Range, arr, i&, x&
   
5. s = s + 1
   
6. If s > 1 Then Exit Sub '限定运行一次代码，避免重复插入行
   
7. arr = Range("g3").CurrentRegion
   
8. For i = 2 To UBound(arr) '循环数组，在b列中从后往前查找
   
9.     Set c = Range("b3").CurrentRegion.Find(arr(i, 1), searchdirection:=xlPrevious)
   
10.     If Not c Is Nothing Then
    
11.     '如果查找到该值，向后插入一行
    
12.         x = c.Row + 1
    
13.         Range("b" & x).Resize(1, 3).Insert Shift:=xlDown
    
14.     Else
    
15.     '否则取最后一行+1
    
16.         x = Cells(Rows.Count, 2).End(xlUp).Row + 1
    
17.     End If
    
18.     '赋值
    
19.     Cells(x, 2) = arr(i, 1)
    
20.     Cells(x, 4) = arr(i, 2)
    
21. Next
    
22. End Sub
    

复制代码