Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1766 / 13645 ツリー ←次へ | 前へ→

【72053】検索コード VBA初心者 12/5/22(火) 20:43 質問[未読]
【72056】Re:検索コード UO3 12/5/23(水) 9:47 発言[未読]
【72057】Re:検索コード UO3 12/5/23(水) 9:51 発言[未読]
【72058】Re:検索コード UO3 12/5/23(水) 10:25 発言[未読]
【72059】Re:検索コード UO3 12/5/23(水) 11:00 発言[未読]
【72067】Re:検索コード VBA初心者 12/5/24(木) 22:44 質問[未読]
【72068】Re:検索コード UO3 12/5/24(木) 23:19 発言[未読]
【72069】Re:検索コード UO3 12/5/24(木) 23:28 発言[未読]
【72070】Re:検索コード UO3 12/5/24(木) 23:39 発言[未読]
【72072】Re:検索コード UO3 12/5/25(金) 6:32 発言[未読]

【72053】検索コード
質問  VBA初心者  - 12/5/22(火) 20:43 -

引用なし
パスワード
   VBAで複数のワークシートを検索するコードの書き方がわかりません。
ワークシートは富士山からの距離別にわけているものであり、距離を
○○k○○○m〜○○k○○○mと入力して検索を押すと該当する複数のワークシートを選択するコードの書き方をどなたか教えて頂きたくお願い申し上げます。

【72056】Re:検索コード
発言  UO3  - 12/5/23(水) 9:47 -

引用なし
パスワード
   ▼VBA初心者 さん:

おはようございます

>○○k○○○m〜○○k○○○mと入力

1.これは、どこかのセルに入力するのですよね?
2.○○は、必ず半角数字ですか?あるいは全角数字ですか? k は必ず半角小文字ですか?

>該当する複数のワークシートを選択する

3.シートは、この名前順に並んでいますか?
4.入力された○○k○○○mという名前を持つシートは必ず存在するのですか?
  それとも、「範囲内」であれば対象ということですか?
5.一番重要なところですけど、「選択」をする意図は?
  「選択」したあと、どんな処理をするのかによって、「選択」そのものは不要かもしれませんので。


で、感想です。
○○k○○○m〜○○k○○○m といった入力って、結構面倒ですよね。
私なんかタイプが不得手なので、間違うかもしれないし。
もし、シートが距離順に並んでいて、かつ「選択」するということが目的なら
・最初のシートをマウスで選択する
・シフトキーを押しながら最後のシートをマウスで選択する
このほうが簡単ではないですか?

【72057】Re:検索コード
発言  UO3  - 12/5/23(水) 9:51 -

引用なし
パスワード
   ▼VBA初心者 さん:

追加で。

○○○m の部分、1000m 以上は無いと決めていいですか?

【72058】Re:検索コード
発言  UO3  - 12/5/23(水) 10:25 -

引用なし
パスワード
   ▼VBA初心者 さん:

細切れで申し訳ありません。

0k0m という指定、あるいはシートはないと考えていいですか?

【72059】Re:検索コード
発言  UO3  - 12/5/23(水) 11:00 -

引用なし
パスワード
   ▼VBA初心者 さん:

こんにちは

とりあえず処理サンプルです。
シート上のボタンにSample をマクロ登録してください。
仮に、○○k○○○m〜○○k○○○m を入力するところを A1 としています。

○○○k○○m の ○○○や○○は全角数字でも半角数字でもOK。
また k も、全角、半角、さらに大文字、小文字 いずれでも。
○○m も 1000m 以上でもOKです。
シートも名前の順番に並んでいなくてもOKです。

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

【72067】Re:検索コード
質問  VBA初心者  - 12/5/24(木) 22:44 -

引用なし
パスワード
   回答いただきありがとうございます。
頂いたコードをもとに編集してみました。
なんとかうまくいったのですが、更に使いやすく改良したくなりました。

ユーザーフォームでtextbox1に○○k○○○m
textbox2に○○k○○○mを入力し、commandbutton1押すと
該当するワークシートを選択する。複数該当する場合は複数選択する。
そして印刷OK/NGを表示させて、印刷するといったVBAを加工したいのですが
全然うまくいきません。もしも良ければアドバイスお願いします。

【72068】Re:検索コード
発言  UO3  - 12/5/24(木) 23:19 -

引用なし
パスワード
   ▼VBA初心者 さん:

コード案提示に加えて上でいくつか質問しています。
その中で "シートを選択" するのはなぜ? というのがあったかと思います。
要は該当のシートを、確認の上印刷すればいいんですね?
シートを、ことさら選択する必要はありませんね。

提示済みのものを、ほぼそのまま使っています。
ユーザーフォームモジュールに。

Private Sub CommandButton1_Click()
  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 s1 As String, s2 As String
  Dim ok As Boolean
 
  s1 = TextBox1.Value
  s2 = TextBox2.Value
  
  If Len(s1) = 0 Or Len(s2) = 0 Then
    MsgBox "シート 開始/終了を入力してから実行してください"
    Exit Sub
  End If
  
  f = getValue(s1)
  If f Then
    t = getValue(s2)
    If t Then ok = True
  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
    Sheets(shN).PrintOut
  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

【72069】Re:検索コード
発言  UO3  - 12/5/24(木) 23:28 -

引用なし
パスワード
   ▼VBA初心者 さん:

↑で、一応コード案をアップしましたが、せっかくユーザーフォームを使うのなら
私ならテキストボックスにいれるのではなく、リストボックスに、シート名を表示して
印刷したいものを複数選択。
もちろん、あるものを選択、別のものをShetfキーを押しながら選択して、その間のものを
すべて選択ということもできますし。

で、印刷ボタンを押しますね。
そうすると、面倒なロジックがほとんど不要になります。

【72070】Re:検索コード
発言  UO3  - 12/5/24(木) 23:39 -

引用なし
パスワード
   ▼VBA初心者 さん:

一応、リストボックスを使った案もアップしておきます。
ListBox1 を配置してください。

Private Sub UserForm_Initialize()
  Dim v() As String
  Dim sh As Worksheet
  Dim k As Long
  
  ReDim v(1 To Worksheets.Count)
  
  For Each sh In Worksheets
    k = k + 1
    v(k) = sh.Name
  Next
  
  With ListBox1
    .List = v
    .MultiSelect = fmMultiSelectExtended
  End With
  
End Sub

Private Sub CommandButton1_Click()
  Dim i As Long
  With ListBox1
    For i = 0 To .ListCount - 1
      If .Selected(i) Then
        PrintOut Sheets(.List(i))
      End If
    Next
  End With
End Sub

【72072】Re:検索コード
発言  UO3  - 12/5/25(金) 6:32 -

引用なし
パスワード
   ▼VBA初心者 さん:

おはようございます

私としては推奨は2番目にアップしたリストボックス方式ですが
最初にアップしたものをお使いになるとすると、これでもいいのですが

For Each shN In shV
    Sheets(shN).PrintOut
Next

このループ処理は

Sheets(shV).PrintOut

この1行でもよかったです。

1766 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free