[已解决]增加一个条件，空白行不保存，谢谢！

wangby

请在以下代码中增加空白行不保存，请看附件，谢谢！

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

9.rar (50.66 KB, 下载次数: 8)

2014-6-15 23:50 上传

点击文件名下载附件


原贴如下：
http://www.excelpx.com/thread-325618-1-1.html

最佳答案

月排行榜 / 总排行榜

FnG

2014-6-15 23:30

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.             If Application.Count(arr) Then
   
9.                 With Sheets(Cells(i, 1).Value)
   
10.                     j = .Range("C:C").Find(Cells(i, "D")).Row
    
11.                     .Cells(j, "M").Resize(, UBound(arr, 2)) = arr
    
12.                 End With
    
13.             End If
    
14.         End If
    
15.     Next i
    
16.     Application.ScreenUpdating = True   '打开屏幕刷新
    
17. End Sub

复制代码

跳转到最佳答案楼层

FnG

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.             If Application.Count(arr) Then
   
9.                 With Sheets(Cells(i, 1).Value)
   
10.                     j = .Range("C:C").Find(Cells(i, "D")).Row
    
11.                     .Cells(j, "M").Resize(, UBound(arr, 2)) = arr
    
12.                 End With
    
13.             End If
    
14.         End If
    
15.     Next i
    
16.     Application.ScreenUpdating = True   '打开屏幕刷新
    
17. End Sub

复制代码

wangby

FnG 发表于 2014-6-16 01:35

谢谢完全OK。