Excel VBA質問箱 IV

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

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


5119 / 13646 ツリー ←次へ | 前へ→

【52530】月間データ範囲取得について yata 07/11/17(土) 20:30 質問[未読]
【52531】Re:月間データ範囲取得について かみちゃん 07/11/17(土) 21:17 発言[未読]
【52533】Re:月間データ範囲取得について yata 07/11/17(土) 22:01 質問[未読]
【52534】Re:月間データ範囲取得について かみちゃん 07/11/17(土) 22:17 発言[未読]
【52542】Re:月間データ範囲取得について yata 07/11/17(土) 23:49 お礼[未読]
【52532】Re:月間データ範囲取得について Hirofumi 07/11/17(土) 21:57 回答[未読]
【52535】Re:月間データ範囲取得について yata 07/11/17(土) 22:18 お礼[未読]
【52538】Re:月間データ範囲取得について Hirofumi 07/11/17(土) 23:07 回答[未読]
【52540】Re:月間データ範囲取得について Hirofumi 07/11/17(土) 23:26 回答[未読]
【52541】Re:月間データ範囲取得について yata 07/11/17(土) 23:37 お礼[未読]
【52548】結果報告とお礼 yata 07/11/18(日) 21:25 お礼[未読]

【52530】月間データ範囲取得について
質問  yata  - 07/11/17(土) 20:30 -

引用なし
パスワード
   こんばんわ
度々お世話になって感謝してます。
今回は以下のことをお願いいたします。

フォームのテキストボックスへ月名を入れて、Sheet1のA2から下の日付データの該当する一番上の行と、一番下の行を取得するため、下の様にしてみましたがこれで問題は無いでしょうか?

最初、上の行はFind関数で、下の行はMACTHワークシート関数でと思ったのですが、どうもMatch関数がうまく行きません。
12月の下に1月が続くとうまく行きませんでした。

1行目は項目行
A2から下へ7月から1年分の日付が入ります。
仮にB列へA列の月名だけを =MONTH(A2) 以下で月名だけ取り出しておく方法をこの掲示板で拝見しましたので利用させて頂いてます。

Sub Test()
Dim myM As String
Dim firstRow As Long, lastRow As Long
Dim f1 As Range, f2 As Range

myM = Range("C1").Value 'テキストボックスの代わり

Set f1 = Sheets("Sheet1").Columns("b").Find(myM, LookIn:=xlValues, LookAt:=xlWhole)
If Not (f1 Is Nothing) Then
  firstRow = f1.Row

 Set f2 = Worksheets("Sheet1").Columns("b").FindPrevious(after:=f1)
  lastRow = f2.Row
End If

MsgBox "上側の行: " & firstRow & "下側の行" & lastRow
Set fc1 = Nothing
Set fc2 = Nothing
End Sub
検索した行が0の場合は別に処理します。

また、もう少し簡単な方法があれば教えていただけませんか?

【52531】Re:月間データ範囲取得について
発言  かみちゃん  - 07/11/17(土) 21:17 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>A2から下へ7月から1年分の日付が入ります。

日付型で7月1日から昇順に1日も抜けなく、1日1行で入力してあるならば、
FindやMatchを使わなくても、7月1日からの経過日数で範囲を自動的に決めること
ができますが、いかがでしょうか?

【52532】Re:月間データ範囲取得について
回答  Hirofumi  - 07/11/17(土) 21:57 -

引用なし
パスワード
   単純に上から月を見ていけば善いのでは?

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim lngRows As Long
  Dim rngList As Range
  Dim vntData As Variant
  Dim vntSearch As Variant
  Dim lngStart As Long
  Dim lngEnd As Long
  Dim strProm As String

  '◆Listの先頭セル位置を基準とする(A列の列見出しのセル位置)
  Set rngList = Worksheets("Sheet1").Cells(1, "A")

  With rngList
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '列データを配列に取得
    vntData = .Offset(1).Resize(lngRows + 1).Value
    'テキストボックスの代わり
    vntSearch = .Parent.Range("C1").Value
  End With
  
  'データの上から下につきを比べる
  For i = 1 To lngRows
    'もし、先頭の行が未定で、探索月と同じ月なら
    If lngStart = 0 And Month(vntData(i, 1)) = vntSearch Then
      lngStart = i
    End If
    'もし、先頭の行が決定されていて、探索月と違う月なら
    If lngStart > 0 And Month(vntData(i, 1)) <> vntSearch Then
      lngEnd = i - 1
      Exit For
    End If
  Next i
  
  If lngStart = 0 Then
    strProm = "目的の" & vntSearch & "月のデータが有りません"
  Else
    strProm = "処理が完了しました" & vbLf _
          & "上側の行: " & (rngList.Row + lngStart) & vbLf _
          & "下側の行: " & (rngList.Row + lngEnd)
  End If
  
Wayout:

  Set rngList = Nothing
   
  MsgBox strProm, vbInformation
     
End Sub

【52533】Re:月間データ範囲取得について
質問  yata  - 07/11/17(土) 22:01 -

引用なし
パスワード
   ▼かみちゃん さん:
>こんにちは。かみちゃん です。
>
かみちゃんさんご返事有難うございます。
>>A2から下へ7月から1年分の日付が入ります。
>
>日付型で7月1日から昇順に1日も抜けなく、1日1行で入力してあるならば、
>FindやMatchを使わなくても、7月1日からの経過日数で範囲を自動的に決めること
>ができますが、いかがでしょうか?
質問の仕方が悪かったです。日付データは昇順ですが在庫管理に使用していますので不定期です。

今は何年か前に作成したプログラムを使っていますが、ソレを見直してもう少し短いコードにしたいと思っています。
会社では私しかVBAをする人がいません。エラー対策をしっかりして、他の人にファイルを引き継がないといけないのです。
今のコードは、For〜Nextで月初めと月末日とで日付セルと比べてそれより大きいか小さいかでやっていますが、来年は閏年になるのでどうなるかなと思います。
また、月末日を得るのにDateSerialの中でDateを使うと前年の月間のデータを出す時困りますよね。
先に掲示したコードで不都合が無いかお聞きしたいです。

【52534】Re:月間データ範囲取得について
発言  かみちゃん  - 07/11/17(土) 22:17 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>今のコードは、For〜Nextで月初めと月末日とで日付セルと比べてそれより大きいか小さいかでやっていますが、来年は閏年になるのでどうなるかなと思います。

Hirofumiさんから代替コードは提案されていますが、
現状のコードを使いたいというのであれば、特に問題はないと思います。
強いていうなら、
 Set fc1 = Nothing
 Set fc2 = Nothing
くらいでしょうか?
閏年は、試しててみてください。
私が勝手に作ったサンプルでは、きちんと取得できてますけど。

>また、月末日を得るのにDateSerialの中でDateを使うと前年の月間のデータを出す時困りますよね。

どう困るのかよくわかりませんが、
 MsgBox DateSerial(2008, 3, 0)
というようなコードの場合、2008/2/29と表示されます。

【52535】Re:月間データ範囲取得について
お礼  yata  - 07/11/17(土) 22:18 -

引用なし
パスワード
   Hirofumi さん 有難うございます。
このコードに近いものを以前回答で書いておられますね。
これでテストしてみます。結果は後ほどお知らせいたします。

>単純に上から月を見ていけば善いのでは?
>
>Option Explicit
>
>Public Sub Sample()
>
>  Dim i As Long
>  Dim lngRows As Long
>  Dim rngList As Range
>  Dim vntData As Variant
>  Dim vntSearch As Variant
>  Dim lngStart As Long
>  Dim lngEnd As Long
>  Dim strProm As String
>
>  '◆Listの先頭セル位置を基準とする(A列の列見出しのセル位置)
>  Set rngList = Worksheets("Sheet1").Cells(1, "A")
>
>  With rngList
>    '行数の取得
>    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
>    If lngRows <= 0 Then
>      strProm = "データが有りません"
>      GoTo Wayout
>    End If
>    '列データを配列に取得
>    vntData = .Offset(1).Resize(lngRows + 1).Value
>    'テキストボックスの代わり
>    vntSearch = .Parent.Range("C1").Value
>  End With
>  
>  'データの上から下につきを比べる
>  For i = 1 To lngRows
>    'もし、先頭の行が未定で、探索月と同じ月なら
>    If lngStart = 0 And Month(vntData(i, 1)) = vntSearch Then
>      lngStart = i
>    End If
>    'もし、先頭の行が決定されていて、探索月と違う月なら
>    If lngStart > 0 And Month(vntData(i, 1)) <> vntSearch Then
>      lngEnd = i - 1
>      Exit For
>    End If
>  Next i
>  
>  If lngStart = 0 Then
>    strProm = "目的の" & vntSearch & "月のデータが有りません"
>  Else
>    strProm = "処理が完了しました" & vbLf _
>          & "上側の行: " & (rngList.Row + lngStart) & vbLf _
>          & "下側の行: " & (rngList.Row + lngEnd)
>  End If
>  
>Wayout:
>
>  Set rngList = Nothing
>   
>  MsgBox strProm, vbInformation
>     
>End Sub

【52538】Re:月間データ範囲取得について
回答  Hirofumi  - 07/11/17(土) 23:07 -

引用なし
パスワード
   ごめん!!

以下を修正して下さい
現状では、年度の最終の月の最終行が取得できません

  'データの上から下につきを比べる
'  For i = 1 To lngRows
  For i = 1 To lngRows + 1 '★変更
    'もし、先頭の行が未定で、探索月と同じ月なら

【52540】Re:月間データ範囲取得について
回答  Hirofumi  - 07/11/17(土) 23:26 -

引用なし
パスワード
   またまた、ごめん!!
もし、最終月に1月が来る事が有るなら
ちゃんと治した方が善いですね

以下の様にして下さい

  'データの上から下につきを比べる
  For i = 1 To lngRows
'  For i = 1 To lngRows + 1 '★変更
    'もし、先頭の行が未定で、探索月と同じ月なら
    If lngStart = 0 And Month(vntData(i, 1)) = vntSearch Then
      lngStart = i
    End If
    'もし、先頭の行が決定されていて、探索月と違う月なら
    If lngStart > 0 And Month(vntData(i, 1)) <> vntSearch Then
      lngEnd = i - 1
      Exit For
    End If
  Next i
  
  '最終月の取得
  If i > lngRows Then '★追加
    If lngStart > 0 Then '★追加
      lngEnd = lngRows '★追加
    End If '★追加
  End If '★追加
  
  If lngStart = 0 Then
    strProm = "目的の" & vntSearch & "月のデータが有りません"

【52541】Re:月間データ範囲取得について
お礼  yata  - 07/11/17(土) 23:37 -

引用なし
パスワード
   Hirofumi さん 度々有難うございます。

>以下を修正して下さい
>現状では、年度の最終の月の最終行が取得できません
>
>  'データの上から下につきを比べる
>'  For i = 1 To lngRows
>  For i = 1 To lngRows + 1 '★変更
>    'もし、先頭の行が未定で、探索月と同じ月なら
修正しました。
日付の下の行が同じ月内で終わっている時 lngEnd が1になってしまって、困っていました。
これを使わして頂きます。
大変有難うございました。勉強になりました。

【52542】Re:月間データ範囲取得について
お礼  yata  - 07/11/17(土) 23:49 -

引用なし
パスワード
   かみちゃん さん Hirohumiさんのコードのテストで見ていませんでした。ごめんなさい。

>現状のコードを使いたいというのであれば、特に問題はないと思います。
>強いていうなら、
> Set fc1 = Nothing
> Set fc2 = Nothing
>くらいでしょうか?

有難うございます。

>>また、月末日を得るのにDateSerialの中でDateを使うと前年の月間のデータを出す時困りますよね。
>
>どう困るのかよくわかりませんが、
> MsgBox DateSerial(2008, 3, 0)
>というようなコードの場合、2008/2/29と表示されます。
MsgBox DateSerial(Date, myM+1, 0)
で使っていました。

かみちゃんさんもHirohumiさんも重ね重ね有難うございました。

【52548】結果報告とお礼
お礼  yata  - 07/11/18(日) 21:25 -

引用なし
パスワード
   Hirohumiさん、かみちゃんさん、Keinさん 有難うございました。
 Hirohumiさんのコードを改造して二つのシートから4つの行位置を出すことが出来ました。
このコードをFunctionに直す方法はKeinさんの記事34482 「戻り値が複数のFanction」 を参考にしました。
 また、Forのループの中で lngStart の値がどの様に変化してゆくかもよく分かり、大変勉強になりました。

下記コードで本ファイルに使わしてもらいます。
皆さん有難うございました。

Sub Kensaku()
Dim mySh As Worksheet
Dim firstR As Long, lastR As Long  'Sheet1の検索された行
Dim firstR2 As Long, lastR2 As Long 'Sheet2の検索された行
Dim i As Long
'Sheet1の上下2個の行を取得する
  Set mySh = Sheets("Sheet1")
  i = GetTwoRowsNum(mySh, firstR, lastR)
  
'Sheet2の上下2個の行を取得する
  Set mySh = Sheets("Sheet2")
  i = GetTwoRowsNum(mySh, firstR2, lastR2)

MsgBox "上側の行: " & firstR & "下側の行" & lastR & vbCrLf & _
  "Sheet2の上の行は" & firstR2 & "下の行は" & lastR2
End Sub

Function GetFourRowNum(Sh As Worksheet, lngStart As Long, lngEnd As Long) As Long
  Dim i As Long
  Dim lngRows As Long 'Sheet1とSheet2の日付が入っている行数
  Dim rngList As Range  'セルA1
  Dim vntData As Variant '日付形式のデータ
  Dim vntSearch As Variant  '指定する月名
  Dim strProm As String  'メッセージ

  '◆Listの先頭セル位置を基準とする(A列の列見出しのセル位置=A1)
  Set rngList = Sh.Cells(1, "A")

  With rngList
    'データの行数を取得
    lngRows = Range("A" & Rows.Count).End(xlUp).Row - 1

    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '列データを配列に取得  A2から最終セルの一つ下のセルまで
    vntData = .Offset(1).Resize(lngRows + 1).Value
    'テキストボックスの代わり
    vntSearch = Sheets("Sheet1").Range("C1").Value
  End With

  'データの上から下につきを比べる
  For i = 1 To lngRows + 1
    'もし、先頭の行が未定で、探索月と同じ月なら
    If lngStart = 0 And Month(vntData(i, 1)) = vntSearch Then
      lngStart = i
    End If
    'もし、先頭の行が決定されていて、探索月と違う月なら
    If lngStart > 0 And Month(vntData(i, 1)) <> vntSearch Then
      lngEnd = i - 1
      Exit For
    End If
    If i > lngRows Then
      If lngStart > 0 Then
        lngEnd = lngRows
      End If
    End If
  Next i

  If lngStart = 0 Then
    strProm = "目的の" & vntSearch & "月のデータが有りません"
  Else
    strProm = "処理が完了しました" & vbLf _
          & "上側の行: " & (rngList.Row + lngStart) & vbLf _
          & "下側の行: " & (rngList.Row + lngEnd)
  End If

Wayout:

  Set rngList = Nothing

  MsgBox strProm, vbInformation

End Function

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