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
老师辛苦了
Sub union方法()
Dim i%, rg As Range
For i = 2 To Range("d65536").End(xlUp).Row
If Range("d" & i) > 20 And rg Is Nothing Then
Set rg = Rows(i)
ElseIf Range("d" & i) > 20 Then
Set rg = Union(rg, Rows(i))
End If
Next i
rg.Select
Set rg = Nothing
End Sub
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
谢谢校长给我鼓励
H07:w2001pf
Option Explicit
Sub 选取1()
Dim rg As Range, x As Integer
For x = 2 To Range("a65536").End(xlUp).Row
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 sr As String, x As Integer
For x = 2 To Range("a65536").End(xlUp).Row
If Range("D" & x) > 20 Then
If sr <> "" Then
sr = sr & "," & x & ":" & x
Else
sr = x & ":" & x
End If
End If
Next x
Range(sr).Select
End Sub
Sub 选取3()
Dim sr As String, x As Integer, k
For x = 2 To Range("a65536").End(xlUp).Row
k = x
If Range("D" & x) > 20 Then
Do While Range("D" & x) > 20
x = x + 1
Loop
sr = sr & k & ":" & x - 1 & ","
End If
Next x
sr = Left(sr, Len(sr) - 1)
Range(sr).Select
End Sub
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
补交作业来罗。
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
Sub aaaa()
Dim i As Long
Dim s As String
s = ""
For i = 2 To 11
s = s & IIf(Cells(i, 4) > 20, i & ":" & i & ",", "")
Next i
s = Left(s, Len(s) - 1)
Range(s).Select
End Sub
Sub cccc()
Dim i As Long
Dim buf As Range
Set buf = Range("a1")
For i = 2 To 11
If Cells(i, 4) > 20 Then
If buf.Address = "$A$1" Then Set buf = Cells(i, 4)
Set buf = Union(Cells(i, 4), buf)
End If
Next i
buf.EntireRow.Select
End Sub
5222002