统计VBA学习小组正式组第九课（第十一讲）的积分帖之作业上交贴（第12周）

冠军欧洲2010

说明:
统计帖每个学员只能跟帖回复一次，也就是在原来回复楼层的基础上点编缉，不要一个链接一层楼，否则不计算积分。
各小组学员上交作业时，一定要点击“我要参加”，并注明自己的新组编号和论坛ID，如果点击过“我要参加”但没有跟帖提交作业的，扣该学员5积分；如果跟帖提交了作业，但没有点“我要参加”的，不给予评分。

请各学员看清上面的说明，免得被扣了分分！
本帖为仅楼主可见帖，直接回复即可！
第九课（第11讲）作业链接：
http://www.excelpx.com/thread-227579-1-1.html

yangrenchao

Sub aa()
Range("3:3,5:5,10:10,11:11").Select
End Sub
Sub bb()
Union(Range("a3:d3"), Range("a5:d5"), Range("a10:d10"), Range("a11:d11")).Select
End Sub
Sub cc()
Union(Rows(11), Rows(10), Rows(5), Rows(3)).Select
End Sub
Sub dd()
Union([3:3], [5:5], [10:10], [11:11]).Select
End Sub

hrpotter

1. Sub row方法()
   
2.     Dim i As Integer
   
3.     Dim st As String
   
4.     For i = 2 To Range("d65536").End(xlUp).Row
   
5.         If Cells(i, 4) > 20 Then
   
6.             If st = "" Then
   
7.                 st = i & ":" & i
   
8.             Else
   
9.                 st = st & "," & i & ":" & i
   
10.             End If
    
11.         End If
    
12.     Next
    
13.     Range(st).Select
    
14. End Sub
    
15. Sub range方法()
    
16.     Dim rg As Range
    
17.     Dim st As String
    
18.     For Each rg In Range("d2:d" & Range("d65536").End(xlUp).Row)
    
19.         If rg.Value > 20 Then
    
20.             If st = "" Then
    
21.                 st = rg.Address
    
22.             Else
    
23.                 st = st & "," & rg.Address
    
24.             End If
    
25.         End If
    
26.     Next
    
27.     Range(st).EntireRow.Select
    
28. End Sub
    
29. Sub union方法()
    
30.     Dim rg As Range
    
31.     Dim rgselect As Range
    
32.     For Each rg In Range("d2:d" & Range("d65536").End(xlUp).Row)
    
33.         If rg.Value > 20 Then
    
34.             If rgselect Is Nothing Then
    
35.                 Set rgselect = rg
    
36.             Else
    
37.                 Set rgselect = Union(rgselect, rg)
    
38.             End If
    
39.         End If
    
40.     Next
    
41.     rgselect.EntireRow.Select
    
42. End Sub

复制代码

C12-hrpotter-VBA基础入门第10课作业题.rar (13.23 KB, 下载次数: 16)

2012-3-14 14:45 上传

点击文件名下载附件

gaoshuichang1

VBA基础入门第10课作业题.zip (8.43 KB, 下载次数: 6)

2012-3-14 16:08 上传

点击文件名下载附件

Sub 选取金额大于20的行()
Dim x As Range, rng As Range
For Each x In Range([d2], [d65536].End(xlUp))
    If x > 20 Then
        If rng Is Nothing Then
            Set rng = x
        Else
            Set rng = Union(rng, x)
        End If
    End If
Next
rng.EntireRow.Select
End Sub

liuho1

Sub rg()

Dim rg As Range, x As Integer

Sheets("Sheet3").Select
For x = 2 To 11
If Range("D" & x) > 20 Then
   Set rg = Range("D" & x)
   Exit For
   End If
   Next
    For x = 2 To 11
   If Range("D" & x) > 20 Then
    Set rg = Union(rg, Range("D" & x))
   End If
  Next
  rg.EntireRow.Select
End Sub


Sub rw()

Dim rw As Range, x As Integer
Sheets("Sheet3").Select
For x = 2 To 11
If Cells(x, 4) > 20 Then
   Set rw = Rows(x)
   Exit For
   End If
   Next
    For x = 2 To 11
   If Cells(x, 4) > 20 Then
    Set rw = Union(rw, Rows(x))
   End If
  Next
  rw.Select
End Sub

qushui

a组学委：qushui

1. Range("3:3,5:5,10:11").Select
   
2. Range("d3,d5,d10,d11").EntireRow.Select
   
3. Union(Rows(3), Rows(5), Rows("10:11")).Select

复制代码

我不知道呀

Sub 方法一()
    Dim i As Integer
    Dim str As String
    Dim str1 As String
    For i = 2 To Range("a65536").End(xlUp).Row
        If Cells(i, 4).Value > 20 Then
            str = str & "d" & i & ","
        End If
    Next
    str1 = Left(str, Len(str) - 1)
    Range(str1).EntireRow.Select
End Sub

Sub 方法一一()
    Dim i As Integer
    Dim str As String
    Dim str1 As String
    Dim rng As Range
    For Each rng In Range("d2: d11")
        If rng > 20 Then
            str = str & rng.Address & ","
        End If
    Next
    str1 = Left(str, Len(str) - 1)
    Range(str1).EntireRow.Select
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub 方法二()
    Dim i As Integer
    Dim rng As Object
    For i = 2 To Range("a65536").End(xlUp).Row
        If Cells(i, 4).Value > 20 Then
        If rng Is Nothing Then
                Set rng = Rows(i & ":" & i)
            Else
                Set rng = Union(rng, Rows(i & ":" & i))
            End If
        End If
    Next
   rng.Select
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub 方法三()
    Dim i As Integer
    Dim rng As Range
    For i = 2 To Range("a65536").End(xlUp).Row
        If Cells(i, 4).Value > 20 Then
            If rng Is Nothing Then
                Set rng = Cells(i, 4)
            Else
                Set rng = Union(rng, Cells(i, 4))
            End If
        End If
    Next i
    rng.EntireRow.Select
End Sub

bynbyn

E13学员bynbyn作业 VBA基础入门第10课作业题.rar (12.62 KB, 下载次数: 14)

2012-3-15 11:54 上传

点击文件名下载附件

sunjing-zxl

E学委:sunjing-zxl
第10课作业题-E学委-sunjing-zxl.rar (13.42 KB, 下载次数: 12)

2012-3-15 14:05 上传

点击文件名下载附件

1. Sub 选取1()
   
2.     Dim arr, i As Long, str As String
   
3.     Dim arr1(), n As Long
   
4.     arr = Range("D2:D" & [D65536].End(xlUp).Row)
   
5.     For i = 1 To UBound(arr)
   
6.         If arr(i, 1) > 20 Then
   
7.             n = n + 1
   
8.             ReDim Preserve arr1(1 To n)
   
9.             arr1(n) = "D" & (i + 1)
   
10.         End If
    
11.     Next i
    
12.     str = Join(arr1, ",")
    
13.     Range(str).EntireRow.Select
    
14. End Sub
    
15. Sub 选取2()
    
16.     Dim rng As Range
    
17.     Dim i As Long, n As Long
    
18.     For i = 2 To [D65536].End(xlUp).Row
    
19.         If Cells(i, 4) > 20 Then
    
20.             n = n + 1
    
21.             If n = 1 Then
    
22.                 Set rng = Cells(i, 4)
    
23.             Else
    
24.                 Set rng = Application.Union(rng, Cells(i, 4))
    
25.             End If
    
26.         End If
    
27.     Next i
    
28.     rng.EntireRow.Select
    
29. End Sub
    
30. Sub 选取3()
    
31.     Dim i As Long, n As Long
    
32.     Dim str As String
    
33.     For i = 2 To [D65536].End(xlUp).Row
    
34.         If Cells(i, 4) > 20 Then
    
35.             n = n + 1
    
36.             If n = 1 Then
    
37.                 str = i & ":" & i
    
38.             Else
    
39.                 str = str & "," & i & ":" & i
    
40.             End If
    
41.         End If
    
42.     Next i
    
43.     Range(str).Select
    
44. End Sub
    
45. 
    

复制代码

1982zyh

1. Sub test1()
   
2. 
   
3. Range("3:3, 5:5, 10:11").Select
   
4. 
   
5. 
   
6. End Sub
   
7. 
   
8. Sub test2()
   
9. 
   
10. 
    
11. Range("d3,d5,d10,d11").Select
    
12. 
    
13. Selection.EntireRow.Select
    
14. 
    
15. End Sub
    
16. 
    
17. 
    
18. Sub test3()
    
19. 
    
20. 
    
21. Union(Rows(3), Rows(5), Rows("10:11")).Select
    
22. 
    
23. 
    
24. End Sub

复制代码

VBA基础入门第10课作业题.rar (11.61 KB, 下载次数: 4)

2012-3-15 22:19 上传

点击文件名下载附件