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

chenzhi_juan

Sub selects()

Dim rg As Range, x As Integer, a As Integer

a = 0

   For x = 2 To 11
   
      If Cells(x, "d") > 20 Then
      
      a = a + 1
   
         If a = 1 Then
         
            Set rg = Rows(x)
            
            Else
            
          Set rg = Union(Rows(x), rg)
            
         End If
         
        End If
        
     Next
     
   rg.Select
  
End Sub

byhdch

A09:byhdch
方法1
Sub 同时选取金额大于20的行1()
  Sheets("sheet3").Select
    Dim rg As Range, i As Integer
      For i = 2 To Range("d65536").End(xlUp).Row
        If Cells(i, 4).Value > 20 Then
            If rg Is Nothing Then
            Set rg = Rows(i)
        Else
           Set rg = Union(rg, Rows(i))
            End If
        End If
     Next i
   rg.Select
End Sub

方法2
Sub 同时选取金额大于20的行2()
  Sheets("sheet3").Select
    Dim rg As Range, i As Integer
      For i = 2 To Range("d65536").End(xlUp).Row
        If Range("d" & i).Value > 20 Then
            If rg Is Nothing Then
            Set rg = Range("d" & i)
        Else
            Set rg = Union(rg, Range("d" & i))
            End If
        End If
     Next i
   rg.EntireRow.Select
End Sub

方法3
Sub 同时选取金额大于20的行3()
  Sheets("sheet3").Select
    Dim rg As Range, i As Integer
      For i = 2 To Range("d65536").End(xlUp).Row
        If Cells(i, 4).Value > 20 Then
            If rg Is Nothing Then
            Set rg = Cells(i, 4)
        Else
           Set rg = Union(rg, Cells(i, 4))
            End If
        End If
     Next i
   rg.EntireRow.Select
End Sub

第10课作业题 A09byhdch.rar (7.99 KB, 下载次数: 7)

2012-3-15 22:58 上传

点击文件名下载附件

jxncfxsf

21组 ID号：jxncfxsf
Sub 选取符合条件的单元格1()
Dim x, y As Long
Dim st As String
For x = 2 To Range("d" & Rows.Count).End(xlUp).Row
  If Cells(x, 4).Value > 20 Then
     st = st & x & ":"
     For y = x + 1 To Range("d" & Rows.Count).End(xlUp).Row
      If Cells(y, 4) > 20 Then
       x = x + 1
       Else: Exit For
         End If
        Next y
        st = st & x & ","
        End If
     Next x
st = Left(st, Len(st) - 1)
Range(st).Select
End Sub

Sub 选取符合条件的单元格2()
  Dim x As Long
  Dim rg As Range
  For x = 2 To Range("d" & Rows.Count).End(xlUp).Row
   If Cells(x, 4) > 20 Then
   If rg Is Nothing Then
      Set rg = Rows(x)
      Else
      Set rg = Union(rg, Rows(x))
     End If
     End If
     Next x
     rg.Select
End Sub

Sub 选取符合条件的单元格3()
  Dim x As Long
  Dim rg As Range
  For x = 2 To Range("d" & Rows.Count).End(xlUp).Row
   If Cells(x, 4) > 20 Then
   If rg Is Nothing Then
   Set rg = Cells(x, 1).Resize(1, Columns.Count)
   Else
   Set rg = Union(rg, Cells(x, 1).Resize(1, Columns.Count))
     rg.Select
     End If
     End If
     Next x
    End Sub

yl_li

只会2种
Sub range方法()
Dim i As Byte
Dim str As String
    For i = 2 To 11
        If Cells(i, 4) > 20 Then
            str = str & i & ":" & i & ","
        End If
    Next i
    str = Left(str, Len(str) - 1)
    Range(str).Select
End Sub

Sub union方法()
Dim i As Byte
Dim rg As Range
    For i = 2 To 11
        If Cells(i, 4) > 20 Then
            If rg Is Nothing Then
                Set rg = Rows(i)
            Else
                Set rg = Union(rg, Rows(i))
            End If
        End If
    Next i
    rg.Select
End Sub

sliang28

1. Sub RgSelect1()     'range选择法
   
2. 
   
3. Dim i As Integer
   
4. Dim rg As Range
   
5. Dim rowstr As String
   
6. 
   
7. i = [D65536].End(xlUp).Row
   
8. 
   
9. rowstr = ""
   
10. 
    
11. For Each rg In Range("D2:D" & i)
    
12.     If rg > 20 Then
    
13.         If rowstr = "" Then
    
14.             rowstr = rowstr & rg.Row & ":" & rg.Row
    
15.         Else
    
16.             rowstr = rowstr & "," & rg.Row & ":" & rg.Row
    
17.         End If
    
18.     End If
    
19. Next
    
20. 
    
21. Range(rowstr).Select
    
22. 
    
23. End Sub
    
24. 
    
25. Sub RgSelect2()     'union选择法
    
26. 
    
27. Dim i As Integer
    
28. Dim j As Integer
    
29. Dim rg As Range
    
30. Dim rgs As Range
    
31. 
    
32. i = [D65536].End(xlUp).Row
    
33. 
    
34. j = 0
    
35. 
    
36. For Each rg In Range("D2:D" & i)
    
37.     If rg > 20 Then
    
38.         If j = 0 Then
    
39.             Set rgs = rg
    
40.             j = j + 1
    
41.         Else
    
42.             Set rgs = Union(rgs, rg)
    
43.         End If
    
44.     End If
    
45. Next
    
46. 
    
47. rgs.EntireRow.Select
    
48. 
    
49. End Sub
    
50. 
    
51. Sub RgSelect3()     'rows选择法
    
52. 
    
53. Dim i As Integer
    
54. Dim j As Integer
    
55. Dim rg As Range
    
56. Dim rgs As Range
    
57. 
    
58. 
    
59. i = [D65536].End(xlUp).Row
    
60. 
    
61. j = 0
    
62. 
    
63. For Each rg In Range("D2:D" & i)
    
64.     If rg > 20 Then
    
65.         If j = 0 Then
    
66.             Set rgs = Rows(rg.Row & ":" & rg.Row)
    
67.             j = j + 1
    
68.         Else
    
69.             Set rgs = Union(rgs, Rows(rg.Row & ":" & rg.Row))
    
70.         End If
    
71.     End If
    
72. Next
    
73. 
    
74. rgs.Select
    
75. 
    
76. End Sub
    

复制代码

梅一枝

Sub 成range()
    Dim x As Integer
    Dim y
    For x = 2 To 11
        If Range("d" & x).Value > 20 Then
            If y = "" Then
                y = Range("d" & x).Address
            Else
                y = y & "," & Range("d" & x).Address
            End If
        End If
    Next x
    Range(y).EntireRow.Select
End Sub


Sub 成union()
    Dim x As Integer
    Dim y As Range
    Dim k As Range
    For x = 2 To 11
        If Range("d" & x).Value > 20 Then
            Set y = Range("d" & x)
            If k Is Nothing Then
                Set k = y
            Else
                Set k = Union(k, y)
            End If
        End If
    Next x
    k.EntireRow.Select
End Sub

Sub 成rows()
    Dim x As Integer
    Dim y As Range
    For x = 2 To 11
        If Range("d" & x).Value > 20 Then
            If y Is Nothing Then
                Set y = Rows(x)
            Else
                Set y = Union(y, Rows(x))
            End If
        End If
    Next x
    y.Select
End Sub

第10课作业题A06 梅一枝.zip (13.28 KB, 下载次数: 3)

2012-3-16 15:29 上传

点击文件名下载附件
个人总结：学的不扎实。

zjyxp

range方法

1. Sub t101()
   
2.     Range("3:3, 5:5, 10:11").Select
   
3. End Sub

复制代码

rows方法

1. Sub t102()
   
2.     Union(Rows("3:3"), Rows("5:5"), Rows("10:11")).Select
   
3. End Sub

复制代码

union方法

1. Sub t103()
   
2.     Union(Range("3:3"), Range("5:5"), Range("10:11")).Select
   
3. End Sub

复制代码

请老师批改指点，非常感谢！

vbamaster

兰版：作业里要求用Range,row和union三种选取方法，这3个方法我都用上了，但体现在两个程序里，第3种程序的实现方法想不出来了，不知道可不可以算通过。
Sub RangSelect()
    Dim sAddress As String
    Dim rg As Range
    For Each rg In Range("d2:d11")
        If rg.Value > 20 Then
            If sAddress = "" Then
                sAddress = rg.Address
            Else
                sAddress = sAddress & "," & rg.Address
            End If
        End If
    Next rg
    sAddress = "" & sAddress & ""
    Range(sAddress).EntireRow.Select
End Sub
Sub UnionSelect()
    Dim sAddress As String
    Dim rg, rg1 As Range
    For Each rg In Range("d2:d11")
        If rg.Value > 20 Then
            If rg1 Is Nothing Then
                Set rg1 = Rows(rg.Row)
            Else
                Set rg1 = Union(rg1, Rows(rg.Row))
            End If
        End If
    Next rg
    rg1.Select
End Sub
VBA基础入门第10课作业题.rar (7.52 KB, 下载次数: 3)

2012-3-17 13:46 上传

点击文件名下载附件
D05:vbamaster

兰江自由鱼

我也做好了作业，不知是否正确？请批改。谢谢！ 兰江自由鱼__VBA基础入门第10课作业题.rar (13.03 KB, 下载次数: 3)

2012-3-17 15:40 上传

点击文件名下载附件

Sub 方法1()   ' range()
    Dim i As Integer, j As Integer
    Dim ss As String
    j = Range("D65536").End(xlUp).Row
    For i = 2 To j
        If Range("D" & i).Value > 20 Then
            ss = ss & i & ":" & i & ","
        End If
    Next i
    ss = VBA.Left(ss, Len(ss) - 1)
    Range(ss).Select
End Sub

Sub 方法2()     'rows()
    Dim i As Integer, j As Integer, k As Integer
    Dim sRg As Range
    j = Range("D65536").End(xlUp).Row
    For i = 2 To j
        If Range("D" & i).Value > 20 Then
            If k = 1 Then
                Set sRg = Union(sRg, Rows(i))
            Else
                Set sRg = Rows(i)
                k = 1
            End If
        End If
    Next i
    sRg.Select
End Sub

Sub 方法3()     'union()+ entirerow
    Dim i As Integer, j As Integer, k As Integer
    Dim sRg As Range, sRg2 As Range
    j = Range("D65536").End(xlUp).Row
    For i = 2 To j
        Set sRg2 = Range("D" & i)
        If sRg2.Value > 20 Then
            If k = 1 Then
                Set sRg = Union(sRg, sRg2)
            Else
                Set sRg = sRg2
                k = 1
            End If
        End If
    Next i
    sRg.Select
    sRg.EntireRow.Select
End Sub

一缕忧兰

A07:一缕忧兰

1. 
   
2. Sub 方法1()
   
3. Dim i As Integer
   
4. Dim m
   
5. For i = 2 To 11
   
6. If Range("D" & i).Value > 20 Then
   
7.     If m = "" Then
   
8.         m = Range("D" & i).Address
   
9.     Else
   
10.         m = m & "," & Range("D" & i).Address
    
11.     End If
    
12.   End If
    
13. Next i
    
14. Range(m).EntireRow.Select
    
15. End Sub
    
16. 
    
17. Sub 方法2()
    
18. Dim i
    
19. Dim R As Range
    
20. For i = 2 To 11
    
21. If Cells(i, "D") > 20 Then
    
22.   If R Is Nothing Then
    
23.     Set R = Range("D" & i)
    
24.   Else
    
25.     Set R = Application.Union(R, Range("D" & i))
    
26.   End If
    
27. End If
    
28. Next i
    
29. R.EntireRow.Select
    
30. End Sub
    
31. 
    
32. Sub 方法3()
    
33. Dim i
    
34. Dim R As Range
    
35. For i = 2 To 11
    
36. If Cells(i, "D") > 20 Then
    
37.   If R Is Nothing Then
    
38.     Set R = Rows(i)
    
39.   Else
    
40.     Set R = Application.Union(R, Rows(i))
    
41.   End If
    
42. End If
    
43. Next i
    
44. R.Select
    
45. End Sub
    

复制代码

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

2012-3-17 17:36 上传

点击文件名下载附件