Excel精英培训网

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

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

  [复制链接]
发表于 2012-3-20 08:56 | 显示全部楼层
Dim x As Integer, m%
Dim arr() As Variant
Private Sub CommandButton1_Click()
    For x = 2 To Cells(Rows.Count, 4).End(3).Row
        If Range("d" & x).Value > 20 Then
        m = m + 1
        ReDim Preserve arr(1 To m)
        arr(m) = "d" & x
        End If
    Next
Range(Join(arr, ",")).EntireRow.Select
End Sub
Private Sub CommandButton2_Click()
Dim rng As Range, x&
    For x = 2 To Cells(Rows.Count, 4).End(3).Row
        If Range("d" & x).Value > 20 Then
            If rng Is Nothing Then Set rng = Rows(x) Else Set rng = Union(rng, Rows(x))
        End If
    Next
If Not rng Is Nothing Then rng.Select
End Sub


回复

使用道具 举报

发表于 2012-3-20 12:18 | 显示全部楼层
老师辛苦了 Janne.71-11组第10课11讲作业题选中多行.rar (18.44 KB, 下载次数: 3)
回复

使用道具 举报

发表于 2012-3-20 14:05 | 显示全部楼层
  1. Sub union方法()
  2. Dim i%, rg As Range
  3. For i = 2 To Range("d65536").End(xlUp).Row
  4.    If Range("d" & i) > 20 And rg Is Nothing Then
  5.        Set rg = Rows(i)
  6.     ElseIf Range("d" & i) > 20 Then
  7.        Set rg = Union(rg, Rows(i))
  8.     End If
  9. Next i
  10. rg.Select
  11. Set rg = Nothing
  12. End Sub
复制代码

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

23 KB, 下载次数: 2

回复

使用道具 举报

发表于 2012-3-20 19:39 | 显示全部楼层
Sub 方式1()
Range("a3:d3,a5:d5.a10:d11").Select

End Sub
Sub 方式2()
Union(Range("a3:d3"), Range("a5:d5"), Range("a10:d11")).Select

End Sub

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

23 KB, 下载次数: 4

回复

使用道具 举报

发表于 2012-3-20 22:12 | 显示全部楼层
谢谢校长给我鼓励
回复

使用道具 举报

发表于 2012-3-21 11:48 | 显示全部楼层
VBA基础入门第10课作业题答题.rar (12.15 KB, 下载次数: 2)
回复

使用道具 举报

发表于 2012-3-21 17:06 | 显示全部楼层
Dim x As Long
For x = 2 To 11
If Range("d" & x) > 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 选取行2()
Dim rg As String
Dim x As Long
For x = 2 To 11
    If Range("d" & x) > 20 Then
        If rg = "" Then
            rg = x & ":" & x
        Else
            rg = rg & "," & x & ":" & x
        End If
    End If
Next x
    Range(rg).Select
End Sub

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

25 KB, 下载次数: 2

回复

使用道具 举报

发表于 2012-3-21 22:53 | 显示全部楼层
补交作业来罗。
Option Explicit
Sub RAGNE方法2()
'这个是我在群内学友提醒用拼装字符方法的提示下自己想出来的,又根据校长的第三种方法改编的
Dim x As Integer
Dim y As Integer, k As Integer
Dim dz As String
    y = 4
    dz = ""
    For x = 2 To 24
        k = x
        If Cells(x, y).Value > 20 Then
           Do While Cells(x, y).Value > 20
              x = x + 1
           Loop
            If dz = "" Then
               dz = k & ":" & x - 1 & ","
            Else
               dz = dz & k & ":" & x - 1 & ","
            End If
        End If
    Next x
    dz = Left(dz, Len(dz) - 1)
    Range(dz).Select
   ' Cells(1, 6).Value = dz
End Sub
Sub RAGNE方法()
'这个是我在群内学友提醒用拼装字符方法的提示下自己想出来的
Dim x As Integer
Dim y As Integer
Dim dz As String
    y = 4
    dz = ""
    For x = 2 To 24
        If Cells(x, y).Value > 20 Then
            dz = dz & x & ":" & x & ","
        End If
    Next x
    dz = Left(dz, Len(dz) - 1)
    Range(dz).Select
   ' Cells(1, 6).Value = dz
End Sub
Sub union2方法()
'这个是抄来的,根据校长的第三种方法修改了
Dim x As Integer, k As Integer
Dim rg As Range
    For x = 2 To Range("d" & Rows.Count).End(xlUp).Row
        k = x
    If Cells(x, 4) > 20 Then
        Do While Cells(x, 4).Value > 20
            x = x + 1
            If rg Is Nothing Then
                Set rg = Rows(k & ":" & x - 1)
            Else
                Set rg = Union(rg, Rows(k & ":" & x - 1))
            End If
        Loop
    End If
    Next x
    rg.Select
End Sub
Sub union1方法()
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

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

13.48 KB, 下载次数: 2

回复

使用道具 举报

发表于 2012-3-22 16:05 | 显示全部楼层
  1. Sub aaaa()
  2.     Dim i As Long
  3.     Dim s As String
  4.     s = ""
  5.     For i = 2 To 11
  6.         s = s & IIf(Cells(i, 4) > 20, i & ":" & i & ",", "")
  7.     Next i
  8.     s = Left(s, Len(s) - 1)
  9.     Range(s).Select
  10. End Sub
  11. Sub cccc()
  12.     Dim i As Long
  13.     Dim buf As Range
  14.     Set buf = Range("a1")
  15.     For i = 2 To 11
  16.         If Cells(i, 4) > 20 Then
  17.             If buf.Address = "$A$1" Then Set buf = Cells(i, 4)
  18.             Set buf = Union(Cells(i, 4), buf)
  19.         End If
  20.     Next i
  21.     buf.EntireRow.Select
  22. End Sub
复制代码
回复

使用道具 举报

发表于 2015-6-14 15:51 | 显示全部楼层
5222002
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 23:16 , Processed in 0.195385 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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