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

wfywcabc · 发表于 2017-5-26 23:52

非常感谢分享！

liujiajun12 · 发表于 2017-5-28 21:50

分享快乐

liujiajun12 · 发表于 2017-5-29 14:50

Sub 第一题()
Application.Intersect([a:a], [b:d].SpecialCells(xlCellTypeConstants).EntireRow) = 1

End Sub

Sub 第二题()
Workbooks.Open (ActiveWorkbook.Path & "\A.xls")
Dim bgs As Integer
bgs = Sheets.Count
Dim i As Integer
Sheets("1月").[a1].CurrentRegion.Copy
Workbooks("第12集练习题.xls").Activate
Sheets("第2题").Select
[a1].Select
ActiveSheet.Paste
For i = 2 To bgs
      Dim ro As Integer
      Dim co As Integer
      Workbooks("A.xls").Activate
      Sheets(i & "月").Select
      [a1].Select
      ro = [a1].CurrentRegion.Rows.Count
      co = [a1].CurrentRegion.Columns.Count
      Range(Cells(2, 1), Cells(ro, co)).Copy
      Workbooks("第12集练习题.xls").Activate
      Sheets("第2题").Select
      ro = [a1].CurrentRegion.Rows.Count
      Cells(ro + 1, 1).Select
      ActiveSheet.Paste
Next i
End Sub

哈啦哈拉 · 发表于 2017-5-29 20:28

Sub 合并()
Dim wb As Workbook
Set wb = Workbooks.Open("E:\A.xls")
Dim x, y, z, d As Integer
For x = 1 To wb.Sheets.Count
y = wb.Sheets(x).Range("a1234").End(xlUp).Row
z = wb.Sheets(x).Cells(1, 10).End(xlToLeft).Column
If x = 1 Then
wb.Sheets(x).Range(Cells(1, 1), Cells(y, z)).Copy Range("a1")
Else:
d = ThisWorkbook.Sheets(3).Range("a1234").End(xlUp).Row + 1
wb.Sheets(x).Range(Cells(2, 2), Cells(y, z)).Copy Range("A" & d)
End If
Next x
wb.Close True
End Sub
'不知道哪里出错了=。=

归来1990 · 发表于 2017-5-31 16:08

看答案

昂扬yang · 发表于 2017-6-1 05:10

everzhukaihua · 发表于 2017-6-1 10:01

学习学习，

殇toHeart丶 · 发表于 2017-6-1 16:07

momom · 发表于 2017-6-2 21:53

momom · 发表于 2017-6-2 22:11

		自动登录	找回密码
密码			注册