Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!

[通知] 统计VBA学习小组正式组第九课(第十一讲)的积分帖之作业上交贴(第12周)

  [复制链接]
发表于 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:}学生不才,只弄了方法一   
B09-开心妙妙-VBA基础入门第10课作业题.rar (10.8 KB, 下载次数: 5)
回复

使用道具 举报

发表于 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
VBA基础入门第10课作业题(linch92413).rar (10.78 KB, 下载次数: 3)
回复

使用道具 举报

发表于 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 | 显示全部楼层
VBA基础入门第10课作业题.rar (10.33 KB, 下载次数: 3)
回复

使用道具 举报

发表于 2012-3-19 14:43 | 显示全部楼层
游客,如果您要查看本帖隐藏内容请回复

VBA基础入门第10课作业题.rar

14.15 KB, 下载次数: 4

回复

使用道具 举报

发表于 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()
[3:3,5:5,10:11].Select
End Sub
Sub tt4()
Union(Rows(3), Rows(5), Rows(10), Rows(11)).Select
End Sub
回复

使用道具 举报

发表于 2012-3-19 16:07 | 显示全部楼层
没弄清楚作业题的意思,把自己理解的都做了一遍
  1. Sub 选取2()
  2.   Dim RG As Range, R As Range
  3.   Set R = Range("D3")
  4.     For Each RG In Range("D2:D11")
  5.       If RG > 20 Then Set R = Union(R, RG)
  6.     Next
  7.   R.EntireRow.Select
  8. End Sub

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

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

  15. Sub XQ4()
  16.   Union(Rows(3), Rows(5), Rows("10:11")).Select
  17. End Sub
复制代码

回复

使用道具 举报

发表于 2012-3-19 16:34 | 显示全部楼层
yijundanny 发表于 2012-3-19 14:43
**** 本内容被作者隐藏 ****

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

VBA基础入门第10课作业题.rar

14 KB, 下载次数: 3

回复

使用道具 举报

发表于 2012-3-19 17:49 | 显示全部楼层
不知道对不对?!
  1. Sub 选取range()
  2. Dim i%
  3. Dim y
  4. For i = 2 To 11
  5. If Range("D" & i).Value > 20 Then
  6.     If y = "" Then
  7.         y = Range("D" & i).Address
  8.     Else
  9.         y = y & "," & Range("D" & i).Address
  10.     End If
  11.   End If
  12. Next i
  13.   Range(y).EntireRow.Select
  14. End Sub
  15. Sub 选取union()
  16.     Dim x%, y%
  17.     Dim rg As Range
  18.     For x = 2 To 11
  19.         If Range("d" & x) > 20 Then
  20.             If Not rg Is Nothing Then
  21.                 Set rg = Union(rg, Range("d" & x))
  22.             Else
  23.                 Set rg = Range("d" & x)
  24.             End If
  25.         End If
  26.     Next
  27.     rg.EntireRow.Select
  28. End Sub

  29. Sub 选取rows()
  30.     Dim i
  31.     Dim y As Range
  32.     For i = 2 To 11
  33.         If Cells(i, "d") > 20 Then
  34.             If y Is Nothing Then
  35.                 Set y = Rows(i)
  36.             Else
  37.                 Set y = Union(y, Rows(i))
  38.             End If
  39.         End If
  40.     Next i
  41.    y.Select
  42. End Sub
复制代码
回复

使用道具 举报

发表于 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 rg  As 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
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 23:44 , Processed in 0.484742 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表