VBA80集第12集作业上交贴：非空行

ign0re

看看

offlinepenguin

kk

Jerry鸽

我就是来看看什么作业，然后学习学习！

wj65134

感谢老师，我来看看答案

思霖

学习

牛鬼勇爪

1

lyn-

想看答案

xj1213

好好学习学习

黄豆飞

看答案

kameric

第一题条件定位非空单元格后就卡在赋值的问题了，突然不给用循环不知道如何给A列赋值，后来参考楼上前辈使用交集区域赋值的思路才做出来，不过这道题真的很有意思。第二题增加了工作簿是否打开的判断，还延伸学习选择性粘贴pastespecial的方法

1. <hide>Sub P12第一题()
   
2. 
   
3. '调用条件定位constant常量，找到B：D列的非空单元格
   
4. '利用range属性entirerow返回整行，使用intersect方法与A列形成矩阵交集获得对应的Range对象，并对交集区域赋值数字1
   
5. Application.Intersect(Columns(1), Range("B:D").SpecialCells(xlCellTypeConstants).EntireRow) = 1
   
6. 
   
7. End Sub
   
8. 
   
9. 
   
10. Sub P12第二题()
    
11. 
    
12. Dim wbx As Workbook                                 '声明工作簿循环变量wbx
    
13. Dim ywb As Workbook                                 '声明数据源对象变量ywb
    
14. Dim x As Integer                                    '声明循环变量x
    
15. Dim lastrg As Range                                 '声明数据区域最后一个单元格变量lastrg
    
16. 
    
17. For Each wbx In Workbooks                           '循环所有工作簿，判断a.xls是否已打开
    
18. If wbx.Name = "a.xls" Then                          '如已打开，对象变量ywb进行初始化赋值，退出循环
    
19. Set ywb = wbx
    
20. Exit For
    
21. End If
    
22. Next wbx
    
23. 
    
24. '若对象变量ywb未赋值，打开同目录下的a.xls，并赋值ywb
    
25. If ywb Is Nothing Then Set ywb = Workbooks.Open(ThisWorkbook.Path & "/a.xls")
    
26. 
    
27. 
    
28. '循环ywb所有工作表
    
29. For x = 1 To ywb.Sheets.Count
    
30. '以每个工作表A1单元格为顶点，定位数据区域的最后一个单元格
    
31. Set lastrg = Sheets(x).Range("a1").CurrentRegion.SpecialCells(xlCellTypeLastCell)
    
32. '第一个工作表，即以A1单元格为顶点复制数据，选择性粘贴至第2题的A1单元格
    
33. If x = 1 Then
    
34. ywb.Sheets(1).Range("A1", lastrg).Copy
    
35. ThisWorkbook.Sheets("第2题").Range("a1").PasteSpecial Paste:=xlPasteValues
    
36. Else
    
37. '其他工作表，则以A2单元格为顶点复制数据，选择性粘贴至第2题A列非空单元格下方
    
38. ywb.Sheets(x).Range("A2", lastrg).Copy
    
39. ThisWorkbook.Sheets("第2题").Range("a65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    
40. End If
    
41. Next x
    
42. 
    
43. ywb.Close False                 '不保存关闭ywb
    
44. 
    
45. End Sub
    
46. </hide>

复制代码