统计VBA学习小组正式组第九课（第十一讲）的积分帖之作业上交贴（第12周） - 第4页 - Excel VBA实战营2期 - Excel精英培训网

开心妙妙 发表于 2012-3-19 09:39

Sub 选取金额大于20的行方法一()
Dim Rng As Range
Dim i As Integer
For i = 2 To 11
If Range("D" & i) > 20 Then
   If Rng Is Nothing Then
      Set Rng = Range("D" & i)
      Else
      Set Rng = Union(Rng, Range("D" & i))
      Rng.EntireRow.Select
   End If
End If
Next i
End Sub

{:011:}学生不才，只弄了方法一

linch92413 发表于 2012-3-19 10:03

E05:linch92413交作业
Sub Range_Methor()
Dim i As Long
Dim R As String
For i = 2 To Range("d65536").End(xlUp).Row
   If Cells(i, 4) > 20 Then
      R = R & "," & i & ":" & i
   End If
Next i
MsgBox Right(R, Len(R) - 1)
Range(Right(R, Len(R) - 1)).Select
End Sub

Sub Row_Methor()
Dim i As Long
Dim R As Range
For i = 2 To Range("d65536").End(xlUp).Row
   If Cells(i, 4) > 20 Then
      If R Is Nothing Then
         Set R = Rows(i)
      Else
         Set R = Union(R, Rows(i))
      End If
   End If
Next i
R.Select
End Sub

Sub Union_Methor()
Dim i As Long
Dim N As String
Dim Rg As Range
For i = 2 To Range("d65536").End(xlUp).Row
   If Cells(i, 4) > 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

君子豹变 发表于 2012-3-19 13:55

Sub 选择1()
Dim rg As Range
Dim r As Integer
For Each rg In Sheets("sheet3").Range("d2:d11")
   If rg > 20 Then
   r = rg.Row
   Rows(r).Select
   Rows(r).Interior.ColorIndex = 3
   End If
Next rg
End Sub

Sub 选择2()
Dim x As Integer, arr(), k, m
k = Application.WorksheetFunction.CountIf(Sheets("sheet3").Range("d2:d11"), ">20")
ReDim arr(1 To k)
Dim r As Integer
For x = 2 To 11
   If Sheets("sheet3").Range("d" & x) > 20 Then
         r = Sheets("sheet3").Range("d" & x).Row
         m = m + 1
         arr(m) = r
   End If
Next x
For x = 1 To k
   Range(arr(x) & ":" & arr(x)).Select
   Rows(arr(x) & ":" & arr(x)).Interior.ColorIndex = 3
Next x
End Sub

Sub 选择3()
Dim rg As Range
Dim r As Integer
For Each rg In Sheets("sheet3").Range("d2:d11")
   If rg > 20 Then
   r = rg.Row
   Union(Range(r & ":" & r), Range(r & ":" & r)).Select
   Union(Range(r & ":" & r), Range(r & ":" & r)).Interior.ColorIndex = 3
   End If
Next rg
End Sub

君子豹变 发表于 2012-3-19 13:57

yijundanny 发表于 2012-3-19 14:43

**** Hidden Message *****

水上漂123 发表于 2012-3-19 14:49

补充一下作业
Sub tt1()
Range("3:3,5:5,10:11").Select
End Sub
Sub tt2()
Union(Range("3:3"), Range("5:5"), Range("10:11")).Select
End Sub
Sub tt3()
.Select
End Sub
Sub tt4()
Union(Rows(3), Rows(5), Rows(10), Rows(11)).Select
End Sub

雨后的风 发表于 2012-3-19 16:07

没弄清楚作业题的意思，把自己理解的都做了一遍^:LSub 选取2()
Dim RG As Range, R As Range
Set R = Range("D3")
For Each RG In Range("D2:D11")
If RG > 20 Then Set R = Union(R, RG)
Next
R.EntireRow.Select
End Sub

Sub XQ2()
Union(Range("3:3"), Range("5:5"), Range("10:11")).Select
End Sub

Sub XQ3()
Range("3:3,5:5,10:11").Select
End Sub

Sub XQ4()
Union(Rows(3), Rows(5), Rows("10:11")).Select
End Sub

yijundanny 发表于 2012-3-19 16:34

yijundanny 发表于 2012-3-19 14:43 static/image/common/back.gif
**** 本内容被作者隐藏 ****

重新修改了程序，现在所有的问题和疑惑都解决了！今天又有收获，谢谢！

wenchduan 发表于 2012-3-19 17:49

不知道对不对？！Sub 选取range()
Dim i%
Dim y
For i = 2 To 11
If Range("D" & i).Value > 20 Then
If y = "" Then
   y = Range("D" & i).Address
Else
   y = y & "," & Range("D" & i).Address
End If
End If
Next i
Range(y).EntireRow.Select
End Sub
Sub 选取union()
Dim x%, y%
Dim rg As Range
For x = 2 To 11
   If Range("d" & x) > 20 Then
         If Not rg Is Nothing Then
            Set rg = Union(rg, Range("d" & x))
         Else
            Set rg = Range("d" & x)
         End If
   End If
Next
rg.EntireRow.Select
End Sub

Sub 选取rows()
Dim i
Dim y As Range
For i = 2 To 11
   If Cells(i, "d") > 20 Then
         If y Is Nothing Then
            Set y = Rows(i)
         Else
            Set y = Union(y, Rows(i))
         End If
   End If
Next i
y.Select
End Sub

lyqzls 发表于 2012-3-19 19:38

Sub 同时选取1()
Range("3:3,5:5,10:11").Select
End Sub
Sub 同时选取2()
Rows方法不能有
End Sub
Sub 同时选取3()
Union(Range("3:3"), Range("5:5"), Range("10:11")).Select
End Sub

Sub 同时选取4()
Dim rgAs Range, rh As Range
Set rg = Range("d3")
For i = 4 To 11
If Range("d" & i) > 20 Then
Set rg = Union(rg, Range("d" & i))
End If
Next
rg.EntireRow.Select
End Sub

页: 1 2 3 [4] 5 6

Excel精英培训网's Archiver