冠军欧洲2010 发表于 2012-3-14 07:43

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

本帖最后由 冠军欧洲2010 于 2012-4-21 13:48 编辑

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

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


yangrenchao 发表于 2012-3-14 13:17

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(, , , ).Select
End Sub

hrpotter 发表于 2012-3-14 14:45

Sub row方法()
    Dim i As Integer
    Dim st As String
    For i = 2 To Range("d65536").End(xlUp).Row
      If Cells(i, 4) > 20 Then
            If st = "" Then
                st = i & ":" & i
            Else
                st = st & "," & i & ":" & i
            End If
      End If
    Next
    Range(st).Select
End Sub
Sub range方法()
    Dim rg As Range
    Dim st As String
    For Each rg In Range("d2:d" & Range("d65536").End(xlUp).Row)
      If rg.Value > 20 Then
            If st = "" Then
                st = rg.Address
            Else
                st = st & "," & rg.Address
            End If
      End If
    Next
    Range(st).EntireRow.Select
End Sub
Sub union方法()
    Dim rg As Range
    Dim rgselect As Range
    For Each rg In Range("d2:d" & Range("d65536").End(xlUp).Row)
      If rg.Value > 20 Then
            If rgselect Is Nothing Then
                Set rgselect = rg
            Else
                Set rgselect = Union(rgselect, rg)
            End If
      End If
    Next
    rgselect.EntireRow.Select
End Sub

gaoshuichang1 发表于 2012-3-14 16:09



Sub 选取金额大于20的行()
Dim x As Range, rng As Range
For Each x In Range(, .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 发表于 2012-3-14 16:28

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 发表于 2012-3-14 17:20

a组学委:qushuiRange("3:3,5:5,10:11").Select
Range("d3,d5,d10,d11").EntireRow.Select
Union(Rows(3), Rows(5), Rows("10:11")).Select

我不知道呀 发表于 2012-3-14 22:34

本帖最后由 我不知道呀 于 2012-3-14 22:35 编辑

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 发表于 2012-3-15 11:54

E13学员bynbyn作业

sunjing-zxl 发表于 2012-3-15 14:05

E学委:sunjing-zxl

Sub 选取1()
    Dim arr, i As Long, str As String
    Dim arr1(), n As Long
    arr = Range("D2:D" & .End(xlUp).Row)
    For i = 1 To UBound(arr)
      If arr(i, 1) > 20 Then
            n = n + 1
            ReDim Preserve arr1(1 To n)
            arr1(n) = "D" & (i + 1)
      End If
    Next i
    str = Join(arr1, ",")
    Range(str).EntireRow.Select
End Sub
Sub 选取2()
    Dim rng As Range
    Dim i As Long, n As Long
    For i = 2 To .End(xlUp).Row
      If Cells(i, 4) > 20 Then
            n = n + 1
            If n = 1 Then
                Set rng = Cells(i, 4)
            Else
                Set rng = Application.Union(rng, Cells(i, 4))
            End If
      End If
    Next i
    rng.EntireRow.Select
End Sub
Sub 选取3()
    Dim i As Long, n As Long
    Dim str As String
    For i = 2 To .End(xlUp).Row
      If Cells(i, 4) > 20 Then
            n = n + 1
            If n = 1 Then
                str = i & ":" & i
            Else
                str = str & "," & i & ":" & i
            End If
      End If
    Next i
    Range(str).Select
End Sub


1982zyh 发表于 2012-3-15 22:19

Sub test1()

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


End Sub

Sub test2()


Range("d3,d5,d10,d11").Select

Selection.EntireRow.Select

End Sub


Sub test3()


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


End Sub
页: [1] 2 3 4 5 6
查看完整版本: 统计VBA学习小组正式组第九课(第十一讲)的积分帖之作业上交贴(第12周)