Excel VBA質問箱 IV

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

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


2869 / 13644 ツリー ←次へ | 前へ→

【65491】セルの選択範囲 nakataka 10/5/26(水) 17:39 質問[未読]
【65492】Re:セルの選択範囲 kanabun 10/5/26(水) 20:32 発言[未読]
【65493】Re:セルの選択範囲 nakataka 10/5/27(木) 8:57 質問[未読]
【65494】Re:セルの選択範囲 kanabun 10/5/27(木) 9:23 発言[未読]
【65495】Re:セルの選択範囲 SS 10/5/27(木) 9:24 発言[未読]
【65498】Re:セルの選択範囲 nakataka 10/5/27(木) 13:30 お礼[未読]
【65499】Re:セルの選択範囲 nakataka 10/5/27(木) 13:39 質問[未読]
【65500】Re:セルの選択範囲 SS 10/5/27(木) 14:14 回答[未読]
【65511】Re:セルの選択範囲 nakataka 10/5/31(月) 9:08 質問[未読]
【65512】Re:セルの選択範囲 SS 10/5/31(月) 10:52 発言[未読]
【65513】Re:セルの選択範囲 nakataka 10/5/31(月) 14:47 質問[未読]
【65496】Re:セルの選択範囲 とおりすがり 10/5/27(木) 12:45 発言[未読]
【65527】Re:セルの選択範囲 メタ 10/6/2(水) 15:25 回答[未読]

【65491】セルの選択範囲
質問  nakataka E-MAIL  - 10/5/26(水) 17:39 -

引用なし
パスワード
   ExcelのVBAで質問します。あるセルに1〜10までの値が順番に入ってます。1〜10の値が入っていて、またその下に1〜10の数字が入ってまして、それが続きます。そのようなシートで1〜10の間を範囲選択したいと思ってます。がたまに1〜9までにしか入っていない事もあり、その時は、1〜9を範囲選択したく思います。どのようにVBを書けば良いか、教えて下さい。ちなみのこれは商品分類ベスト10という形で1〜10をあらわしてます

【65492】Re:セルの選択範囲
発言  kanabun  - 10/5/26(水) 20:32 -

引用なし
パスワード
   ▼nakataka さん:

質問ですが、
>あるセルに1〜10までの値が順番に入ってます。1〜10の値が入っていて、またその下に1〜10の数字が入ってまして、それが続きます。そのようなシートで1〜10の間を範囲選択したいと思ってます。がたまに1〜9までにしか入っていない事もあり、その時は、1〜9を範囲選択したく思います。

> ちなみのこれは商品分類ベスト10という形で1〜10をあらわしてます

具体例を示された方がよろしいかと。

ある列に

 1
 2
 :
 :
 8
 9
10

のように 順番に入っているのか?

ある列に、
 8
 
 2
 1
 3

 9
10

のように入っているのか、
分からないです。

それらの数字が その列に 1回しか出現しないのなら
ワークシート関数の Match を使うと検索できますよ

【65493】Re:セルの選択範囲
質問  nakataka E-MAIL  - 10/5/27(木) 8:57 -

引用なし
パスワード
   ▼kanabun さん:
具体的に

 1 いちご
 2 みかん
 :
 :
 8 ぶるーべりー
 9 めろん
 10 いちじく
 1 にんじん 
 2 かぼちゃ
 :
 :
 8 ほうれん草
 9 たまねぎ


のように 順番に入ってます。
それを

  ──────────
 │1 いちご     │
 │2 みかん     │
 │:         │
 │:         │
 │8 ぶるーべりー  │
 │9 めろん     │
 │10 いちじく    │
  ──────────
このように、罫線を引くプログラムを作成していたのですが、
1〜9までしがない群もあるので、それがうまく認識して1〜9に罫線をひけなかったので、質問しました。

【65494】Re:セルの選択範囲
発言  kanabun  - 10/5/27(木) 9:23 -

引用なし
パスワード
   ▼nakataka さん:

>のように 順番に入ってます。

なるほど。
各行に もれなく数値が しかも順番に 入っているんですか?

だとすると、
2行目から下へ順番にみていって、数値がひとつ上のセルより
小さくなっているセルに罫線をひく

とか、

「1」のセルの上に罫線をひく + 最終行に罫線をひく

とか、で、割り出せそうなきがしますが?

【65495】Re:セルの選択範囲
発言  SS  - 10/5/27(木) 9:24 -

引用なし
パスワード
   ▼nakataka さん:
▼kanabun さん:
横から失礼します。
作っている間に書き込みがあったので少し不足、余分がありますが
多分対応できると思います。確認してみてください。
罫線部分は select部を変更して下さい。
Sub test()
  Dim i As Long, j As Long
  Dim RS As Long, RE As Long
  Dim TC As Integer 'データのある列数
  j = 1
  TC = 1
  For i = 2 To Cells(65536, TC).End(xlUp).Row
    If Cells(i, TC).Value = 1 Then
      If RS = 0 Then
        RS = i
      Else
        RE = i - 1
        RowS(RS & ":" & RE).Select
        MsgBox "範囲 " & j & " です"
        j = j + 1
        RS = i
        RE = 0
      End If
    ElseIf Cells(i, TC).Value = 10 Then
      If RS = 0 Then
        MsgBox "範囲の始まりが不明です"
      Else
        RE = i
        RowS(RS & ":" & RE).Select
        MsgBox "範囲 " & j & " です"
        j = j + 1
        RS = 0
        RE = 0
      End If
    ElseIf RS > 0 Then
      If Cells(i, TC).Value < Cells(i - 1, TC).Value Or _
          Cells(i, TC).Value > 9 Then
        RE = i - 1
        RowS(RS & ":" & RE).Select
        MsgBox "範囲 " & j & " です"
        j = j + 1
        RS = 0
        RE = 0
      End If
    End If
  Next i
End Sub

>具体的に
>
> 1 いちご
> 2 みかん
> :
> :
> 8 ぶるーべりー
> 9 めろん
> 10 いちじく
> 1 にんじん 
> 2 かぼちゃ
> :
> :
> 8 ほうれん草
> 9 たまねぎ
>
>
>のように 順番に入ってます。
>それを
>
>  ──────────
> │1 いちご     │
> │2 みかん     │
> │:         │
> │:         │
> │8 ぶるーべりー  │
> │9 めろん     │
> │10 いちじく    │
>  ──────────
>このように、罫線を引くプログラムを作成していたのですが、
>1〜9までしがない群もあるので、それがうまく認識して1〜9に罫線をひけなかったので、質問しました。

【65496】Re:セルの選択範囲
発言  とおりすがり  - 10/5/27(木) 12:45 -

引用なし
パスワード
   h tp://okwave.jp/qa/q5923372.html
こちらも参考にどうぞ。

【65498】Re:セルの選択範囲
お礼  nakataka E-MAIL  - 10/5/27(木) 13:30 -

引用なし
パスワード
   返信、ありがとうございます。
まず、コピペして動きを確認しています。
何か分からない構文などに当たれば、また質問させて頂きます。
ありがとうございました。

【65499】Re:セルの選択範囲
質問  nakataka E-MAIL  - 10/5/27(木) 13:39 -

引用なし
パスワード
   Sub test()
  Dim i As Long, j As Long
  Dim RS As Long, RE As Long
  Dim TC As Integer 'データのある列数
  j = 1
  TC = 1
  For i = 2 To Cells(65536, TC).End(xlUp).Row
    If Cells(i, TC).Value = 1 Then
      If RS = 0 Then
        RS = i
      Else
        RE = i - 1
        Rows(RS & ":" & RE).Select
        MsgBox "範囲 " & j & " です"
        j = j + 1
        RS = i
        RE = 0
      End If
途中のRS =0から下がもう一つ動きがわかりません。
RE=i-1など詳しく教えてもらえませんでしょうか?

【65500】Re:セルの選択範囲
回答  SS  - 10/5/27(木) 14:14 -

引用なし
パスワード
   ▼nakataka さん:

説明不足過ぎましたね済みません。
先ずRSは範囲初め、REは範囲の最後行を表します。
RS=0は範囲の初めが設定されていない状態です。

一応下に説明加えましたがデータがスペース等なく、1〜10以下の数字で
埋められているのならば参照セルが1かどうかだけを判断してやれば
良いと思います。(最初の範囲の処理だけは注意が必要)

Sub test2()
  Dim i As Long, j As Long
  Dim RS As Long
  j = 1
  RS = 2 'データが2行目から始まる前提です。でなければフラグが必要
  For i = 3 To Cells(65536, 1).End(xlUp).Row
    If Cells(i, TC).Value = 1 Then
      Range(Cells(RS, 1), Cells(i - 1, 2)).Select
      MsgBox "範囲 " & j & " です"
      RS = i
    End If
  Next i
End Sub

>Sub test()
>  Dim i As Long, j As Long
>  Dim RS As Long, RE As Long
>  Dim TC As Integer 'データのある列数
>  j = 1
>  TC = 1
>  For i = 2 To Cells(65536, TC).End(xlUp).Row
>    If Cells(i, TC).Value = 1 Then
    参照セルが1の場合は強制的にRS=参照行となるのですが
>      If RS = 0 Then
>        RS = i
>      Else
    RS<>0の場合は以前の範囲指定処理が済んでいない状態(例9で終わる)
    ですので範囲の終わりは今参照している一つ上の行(=i-1)です
>        RE = i - 1
>        Rows(RS & ":" & RE).Select
>        MsgBox "範囲 " & j & " です"
>        j = j + 1
    前の範囲処理が済んでから、範囲設定RS=参照行を行います。
>        RS = i
>        RE = 0
>      End If
>途中のRS =0から下がもう一つ動きがわかりません。
>RE=i-1など詳しく教えてもらえませんでしょうか?

【65511】Re:セルの選択範囲
質問  nakataka E-MAIL  - 10/5/31(月) 9:08 -

引用なし
パスワード
   ありがとうございます。

Sub test2()
  Dim i As Long, j As Long
  Dim RS As Long
  j = 1
  RS = 2 'データが2行目から始まる前提です。でなければフラグが必要
  For i = 3 To Cells(65536, 1).End(xlUp).Row
    If Cells(i, TC).Value = 1 Then
      Range(Cells(RS, 1), Cells(i - 1, 2)).Select
      MsgBox "範囲 " & j & " です"
      RS = i
    End If
  Next i
End Sub

この構文を解析して、何とか作成しています。
が、罫線を引く事を目的にしています。
ので、表の一番下の範囲を選択できません。
何かいい方法はないでしょうか?

【65512】Re:セルの選択範囲
発言  SS  - 10/5/31(月) 10:52 -

引用なし
パスワード
   ▼nakataka さん:

>ありがとうございます。
>
>この構文を解析して、何とか作成しています。
>が、罫線を引く事を目的にしています。
>ので、表の一番下の範囲を選択できません。
>何かいい方法はないでしょうか?

先ずは、どのような方法をご自身で試されたのか書いた方がよろしいかと思います。
この書かれ方だと私以外に解答し難くると思います。ご自身の状況を明示した方が他の方から新しい情報を得易いと思います。また私もいつもこの質問箱で勉強させていただいている身でスキルはありませんので最適な方法を提示しているわけではなく、「今の自分ならこの方法で出来るけど参考になるかな?」というものを投稿していますのでご理解下さい。
一応最終データに対応するよう追加しておきましたが、やはり初めに投稿したようなデータごとの終了行を判断するようにしたほうが汎用性があると思います。

Sub test2()
  Dim i As Long, j As Long
  Dim RS As Long, RE As Long
  j = 1
  RS = 2 'データが2行目から始まる前提です。でなければフラグが必要
  RE = Cells(65536, 1).End(xlUp).Row 'データの最終行(データ範囲の最後)
  For i = 3 To RE
    If Cells(i, TC).Value = 1 Then
      Range(Cells(RS, 1), Cells(i - 1, 2)).Select
      MsgBox "範囲 " & j & " です"
      RS = i
      j = j + 1
    ElseIf i = RE Then
      Range(Cells(RS, 1), Cells(i, 2)).Select
      MsgBox "範囲 " & j & " です"
    End If
  Next i
End Sub

【65513】Re:セルの選択範囲
質問  nakataka E-MAIL  - 10/5/31(月) 14:47 -

引用なし
パスワード
   本当にありがとうございます。
今、解析しているのですが、
Sub test2()
  Dim i As Long, j As Long
  Dim RS As Long, RE As Long
  j = 1
  RS = 2 'データが2行目から始まる前提です。でなければフラグが必要
  RE = Cells(65536, 1).End(xlUp).Row 'データの最終行(データ範囲の最後)
  For i = 3 To RE
    If Cells(i, TC).Value = 1 Then
      Range(Cells(RS, 1), Cells(i - 1, 2)).Select
      MsgBox "範囲 " & j & " です"
      RS = i
      j = j + 1
    ElseIf i = RE Then
      Range(Cells(RS, 1), Cells(i, 2)).Select
      MsgBox "範囲 " & j & " です"
    End If
  Next i
End Sub

最後の
Range(Cells(RS, 1), Cells(i, 2)).Select
の構文は、最終行を範囲選択していますが、この場合のRS は、どこの範囲を選んでいるのでしょうか?
RS = 2としていますが、そこは無効になっているのは、分かります。

【65527】Re:セルの選択範囲
回答  メタ  - 10/6/2(水) 15:25 -

引用なし
パスワード
   こんにちは。
こんなのはどうでしょうか。

Sub test()

  Dim r, rTop, rBot
  
  r = 1
  Do Until Cells(r, 1).Value = 1
    r = r + 1
  Loop
  
  Do Until Cells(r, 1).Value = ""
    If Cells(r, 1).Value = 1 Then rTop = r
    If Cells(r + 1, 1).Value < Cells(r, 1).Value Then rBot = r
    If rBot > 0 Then
      Debug.Print Range(Cells(rTop, 1), Cells(rBot, 2)).Address
      rBot = 0
    End If
    r = r + 1
  Loop

End Sub

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