[已解决]数据另存

ms967967

将数据表里B列内容另存到存放表里（B列会有几百条信息）
要求：
　　1.按日期顺序依次填加保存。
　　2.当日期相同时将原数据覆盖。日期不同时存到下一列
附件在2楼

最佳答案

月排行榜 / 总排行榜

dsmch

2014-10-10 21:49

1. Sub Macro1()
   
2. Dim c As Range, n&
   
3. Sheet1.Activate
   
4. s = Cells(Rows.Count, 2).End(xlUp).Row
   
5. Set c = Sheet2.Rows(1).Find([b1], lookat:=xlWhole)
   
6. If Not c Is Nothing Then
   
7.     [b1].Resize(s).Copy c
   
8. Else
   
9.     n = Sheet2.Cells(1, Columns.Count).End(xlToLeft).Column + 1
   
10.     [b1].Resize(s).Copy Sheet2.Cells(1, n)
    
11. End If
    
12. End Sub

复制代码

跳转到最佳答案楼层

ms967967

另存.rar (8.74 KB, 下载次数: 12)

2014-10-10 21:17 上传

点击文件名下载附件

dsmch

1. Sub Macro1()
   
2. Dim c As Range, n&
   
3. Sheet1.Activate
   
4. s = Cells(Rows.Count, 2).End(xlUp).Row
   
5. Set c = Sheet2.Rows(1).Find([b1], lookat:=xlWhole)
   
6. If Not c Is Nothing Then
   
7.     [b1].Resize(s).Copy c
   
8. Else
   
9.     n = Sheet2.Cells(1, Columns.Count).End(xlToLeft).Column + 1
   
10.     [b1].Resize(s).Copy Sheet2.Cells(1, n)
    
11. End If
    
12. End Sub

复制代码

这儿有肥猫

1. Sub a()
   
2. Dim arr, i As Range, j&
   
3. arr = Sheets("数据").Range("b2:b" & Sheets("数据").Cells(Rows.Count, 2).Row)
   
4. 
   
5. Set i = Sheets("存放").Rows(1).Find(Sheets("数据").[b1], lookat:=xlWhole)
   
6. 
   
7. With Sheets("存放")
   
8. j = .Cells(1, Columns.Count).End(xlToLeft).Column
   
9. 
   
10. If Not i Is Nothing Then
    
11. 
    
12.    .Range(Cells(2, i.Column), Cells(.Cells(Rows.Count, i.Column).End(3).Row, i.Column)).ClearContents
    
13.    .Cells(2, i.Column).Resize(UBound(arr), 1) = arr
    
14.    
    
15. Else
    
16. 
    
17.    .Cells(1, j + 1) =Sheets("数据").[b1]
    
18.    .Cells(2, j + 1).Resize(UBound(arr), 1) = arr
    
19.    
    
20. End If
    
21. 
    
22. End With
    
23. 
    
24. End Sub

复制代码

ms967967

您的这个版本日期相同时不能覆盖