根据条件写保存代码，谢谢！

wangby

9.rar (44.42 KB, 下载次数: 4)

2014-5-24 23:46 上传

点击文件名下载附件

byhdch

1. Private Sub CommandButton1_Click()
   
2.     Dim i As Long, j&
   
3.     Dim arr
   
4.     Application.ScreenUpdating = False  '关闭屏幕刷新
   
5.     For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
   
6.         If Cells(i, "D") <> "" Then
   
7.             arr = Range(Cells(i, "N"), Cells(i, "Y"))
   
8.             With Sheets(Cells(i, 1).Value)
   
9.                 j = .Range("C:C").Find(Cells(i, "D")).Row
   
10.                 .Cells(j, "M").Resize(, UBound(arr, 2)) = arr
    
11.             End With
    
12.         End If
    
13.     Next i
    
14.     Application.ScreenUpdating = True   '打开屏幕刷新
    
15. End Sub
    

复制代码

9.rar (53.41 KB, 下载次数: 15)

2014-5-25 00:02 上传

点击文件名下载附件

wangby

byhdch 发表于 2014-5-24 23:26

谢谢，我写错了保存区域，是N3：Y10，能否帮手再看一下，谢谢您！

qh8600

wangby 发表于 2014-5-24 23:30
谢谢，我写错了保存区域，是N3：Y10，能否帮手再看一下，谢谢您！

.Cells(j, "M").Resize(, UBound(arr, 2)) = arr
把这里的M改成N

byhdch

qh8600 发表于 2014-5-25 12:01
.Cells(j, "M").Resize(, UBound(arr, 2)) = arr
把这里的M改成N

你可能没看清哦，源数据arr = Range(Cells(i, "N"), Cells(i, "Y"))，目标区域.Cells(j, "M").Resize(, UBound(arr, 2)) = arr   

wangby

byhdch 发表于 2014-5-25 13:12
你可能没看清哦，源数据arr = Range(Cells(i, "N"), Cells(i, "Y"))，目标区域.Cells(j, "M").Resize(, ...

您写的代码，完全符合需求，谢谢！

如您有时间的话，能否再帮手写一段查询的代码，之前是保存的代码，问题连接如下，谢谢您！

http://www.excelpx.com/thread-325630-1-1.html

wangby

byhdch 发表于 2014-5-25 13:12
你可能没看清哦，源数据arr = Range(Cells(i, "N"), Cells(i, "Y"))，目标区域.Cells(j, "M").Resize(, ...

您好，谢谢您帮手，能否帮手再写一段代码呀，谢谢！

http://www.excelpx.com/thread-325891-1-1.html