| |
2日間、アクセスできませんので、
Sub 範囲セット() 方式（手動実行）を値が1つのときに対応できるように
微修正したものです。
Sub 範囲セット2()
Dim i As Long
Dim r1 As Range, r2 As Range
Dim v
With ActiveSheet
Set r1 = .Cells(.Rows.Count, "I").End(xlUp).Offset(1)
Set r2 = .Cells(.Rows.Count, "L").End(xlUp)
v = Excel.Range(r1.Offset(, 3), r2).Value
'-----------------------------------------------------------
If Not IsArray(v) Then '★4行 追加
ReDim v(1 To 1, 1 To 1)
v(1, 1) = r1.Offset(, 3).Value
End If
'-----------------------------------------------------------
ReDim sa(1 To UBound(v), 0) As String
For i = 1 To UBound(v)
If Not IsEmpty(v(i, 1)) Then
Select Case v(i, 1)
Case Is >= 501: sa(i, 0) = "501 - "
Case Is >= 451: sa(i, 0) = "451 - 500"
Case Is >= 401: sa(i, 0) = "401 - 450"
Case Is >= 351: sa(i, 0) = "351 - 400"
Case Is >= 301: sa(i, 0) = "301 - 350"
Case Is >= 251: sa(i, 0) = "251 - 300"
Case Is >= 201: sa(i, 0) = "201 - 250"
Case Is >= 151: sa(i, 0) = "151 - 200"
Case Is >= 101: sa(i, 0) = "101 - 150"
Case Else: sa(i, 0) = " - 100"
End Select
End If
Next
r1.Resize(UBound(v)).Value = sa
End With
End Sub
|
|
kanabun
- 14/4/8(火) 10:07 -
