| |
▼VBA初心者 さん：
こんにちは
とりあえず処理サンプルです。
シート上のボタンにSample をマクロ登録してください。
仮に、○○k○○○m〜○○k○○○m を入力するところを A1 としています。
○○○k○○m の ○○○や○○は全角数字でも半角数字でもＯＫ。
また k も、全角、半角、さらに大文字、小文字 いずれでも。
○○m も 1000m 以上でもＯＫです。
シートも名前の順番に並んでいなくてもＯＫです。
Sub Sample()
Dim sh As Worksheet
Dim shN As Variant
Dim shV() As String
Dim k As Long
Dim f As Double, t As Double, n As Double
Dim v As Variant
Dim ok As Boolean
v = Split(Range("A1").Value, "〜") '★指定セルは実際のものに
If UBound(v) = 1 Then
f = getValue(v(0))
If f Then
t = getValue(v(1))
If t Then ok = True
End If
End If
If Not ok Then
MsgBox "シート範囲を正しく指定してください"
Exit Sub
End If
ReDim shV(1 To Worksheets.Count)
For Each sh In Worksheets
n = getValue(sh.Name)
If n >= f And n <= t Then
k = k + 1
shV(k) = sh.Name
End If
Next
If k = 0 Then
MsgBox "該当のシートがありません"
Exit Sub
End If
ReDim Preserve shV(1 To k)
If MsgBox("以下のシートが選ばれました。よろしいですか？" & vbLf & _
Join(shV, vbLf), vbYesNo) = vbNo Then Exit Sub
For Each shN In shV
With Sheets(shN)
'
'ここに、このシートに対する処理コードを書きます。
'たとえば以下のように。
'Range記述やCells記述の場合、先頭にピリオドをつけてください。
.Range("A1").Value = "ABC"
End With
Next
End Sub
Private Function getValue(ByVal s As Variant) As Double
Dim wk As Variant
s = LCase(StrConv(s, vbNarrow))
wk = Split(s, "k")
If UBound(wk) = 1 Then
getValue = Val(wk(0)) + Val(wk(1)) / 1000
End If
End Function
|
|
UO3
- 12/5/23(水) 11:00 -
