ここから本文です

Vba にて、5秒間隔で一ヶ月間取得したデータを1日ごとに別のブックで保存したいた...

uma********さん

2016/7/2218:40:52

Vba にて、5秒間隔で一ヶ月間取得したデータを1日ごとに別のブックで保存したいため、マクロを組もうと思います。

そこである列に日付が格納されているため、その列内を上から対象日を検索して、まず1番始めの行番号を取得し、次にブックの最下部から検索して、対象日の1番下の行番号を取得して、コピーする範囲を選択しようと思います。

この部分はどのように書けばいいでしょうか。
また、これ以外に画期的な範囲の定め方があればその考え方をご教授願いませんでしょうか

閲覧数:
45
回答数:
1
お礼:
25枚

違反報告

ベストアンサーに選ばれた回答

あーばさん

2016/7/2304:59:13

指定の方法で範囲を取得するコードを作成しました。
GetSelectRange を呼び出して使用してください。
実行前に以下の定数を指定する必要があります。
DATE_COLUMN - 日付が格納されている列番号
SELECT_START_COLUMN - 選択開始列
SELECT_END_COLUMN - 選択終了列

--
' 対象の日付が見つからない場合のエラー
Const NO_TARGET_DATE_ERR = 1 + 512
Const DATE_COLUMN As Integer = XXX ' 日付が入力された列を数値指定

' 実行テスト
Sub run()
On Error GoTo ErrHandler

Dim r As Range

Set r = GetSelectRange(CDate("2016/7/1"))
r.Select
Exit Sub

ErrHandler:
MsgBox Err.Number & " " & Err.Description
End Sub


Function GetSelectRange(target_date As Date) As Range
Const SELECT_START_COLUMN As Integer = XXX ' 選択開始列を数値指定
Const SELECT_END_COLUMN As Integer = XXX ' 選択終了列を数値指定

Dim select_start_row As Integer
Dim select_end_row As Integer
select_start_row = GetSeletctStartRow(target_date)
select_end_row = GetSelectEndRow(target_date)

If select_start_row = 0 Or select_end_row = 0 Then
Err.Raise NO_TARGET_DATE_ERR, , "対象の日付 " & target_date & " が見つかりません。"
End If

Set GetSelectRange = _
Range(Cells(select_start_row, SELECT_START_COLUMN), _
Cells(select_end_row, SELECT_END_COLUMN))

End Function

Private Function GetSeletctStartRow(target_date As Date) As Integer
Dim select_start_row As Integer: select_start_row = 0

Dim max_row As Integer
max_row = Cells(Rows.Count, DATE_COLUMN).End(xlUp).Row

Dim i As Integer: i = 1
Do Until i > max_row
Dim d As Date: d = Cells(i, DATE_COLUMN).Value
If d = target_date Then
Exit Do
End If
i = i + 1
Loop
GetSeletctStartRow = i
End Function

Private Function GetSelectEndRow(target_date As Date) As Integer
Dim select_end_row As Integer: select_end_row = 0

Dim max_row As Integer
max_row = Cells(Rows.Count, DATE_COLUMN).End(xlUp).Row

Dim i As Integer: i = max_row
Do Until i < 1
Dim d As Date: d = Cells(i, DATE_COLUMN).Value
If d = target_date Then
Exit Do
End If
i = i - 1
Loop
GetSelectEndRow = i
End Function

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる