エクセルのVBA初心者が時間の範囲指定でデータを合計する方法は?

このQ&Aのポイント
  • エクセルのVBA初心者ですが、時間の範囲を指定してデータを合計する方法を知りたいです。
  • VBAを使って、「最初の時間から最後の時間まで」の範囲を指定し、その範囲内のデータを合計する方法について教えてください。
  • エクセルで特定の時間範囲のデータの合計を求めるために、VBAを使ってセルの範囲を指定する方法について教えてください。
回答を見る
  • ベストアンサー

エクセルで検索した2個のセルの間を範囲指定する。

エクセルのVBA初心者です。(excel 2007使用) 初投稿にて至らない部分もありますが、どうぞ宜しくお願い致します。 下の様なデータが1分おきにずっと続いています。 時間(A列)個数(B列) 13:00:00   19 13:01:00   4 13:02:00   0 13:03:00   8 13:04:00   16 13:05:00   2 13:06:00   1 13:07:00   32 このデータで 何処かに時間の最初と最後を入力する箇所を設けて、マクロを実行するだけでその合計を出したいです。 指定する時間帯が場合によって変わる為、 Range("最初の時間を検索しヒットしたセル : 最後の時間を検索しヒットしたセル").Select Selection.Offset(0, 1).Select を考え、cells.findを使おうとするも、うまく実行出来ませんでした。 何かよい方法はございますでしょうか。 何卒宜しくお願い致します。

質問者が選んだベストアンサー

  • ベストアンサー
  • tsubuyuki
  • ベストアンサー率45% (699/1545)
回答No.2

もちろん、関数だけで何とでも出来る話ではありますが、 > cells.findを使おうとするも、うまく実行出来ませんでした。 との事ですから、折角なのでコレを使って考えてみました。 日付・時刻は表示そのまま(MM/DD とか hh:mm)だと使いづらいので、 日付型の変数を宣言して、そこに格納して使うと楽です。 踏まえて、A列に時刻が、B列に個数が並んでいるときに D2セルに開始時刻を、E2セルに終了時刻を入力し、 F2セルに合計を書き出すようにすると考えると、 Sub Test() Dim SCell As Range, ECell As Range Dim STime As Date, ETime As Date '開始・終了時刻を変数に格納 STime = Range("D2").Value ETime = Range("E2").Value '変数を基に検索し、ヒットしたセルの右隣のセルを変数に格納 Set SCell = Columns(1).Find(STime).Offset(0, 1) Set ECell = Columns(1).Find(ETime).Offset(0, 1) 'SUM関数で合計を算出 Range("F2") = WorksheetFunction.Sum(Range(SCell, ECell)) End Sub こんな流れでいかがでしょう? ここに、開始と終了の時刻が逆転している時だとか、 片方が入っていない時にどう対処するかを加えると良いかもしれませんね。

tive005
質問者

お礼

皆様迅速な対応を誠に有難う御座いました。 tubuyukiさんの仰るとおり時間の問題が有りましたが、 一番私にとってわかりやすく、excel2003でも出来て、かつ拡張が楽でしたので、 ベストアンサーに選ばせて頂きました。 大変有難う御座いました。

その他の回答 (2)

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.3

こんばんは! すでに回答は出ていますが・・・ 時刻などに関しては浮動小数点誤差の関係できっちり計算できないような気がします。 そこでF列を作業用の列として使用し、小数点以下5桁で丸めてみました。 ↓の画像のようにE1・E2セルにそれぞれの時刻、E3セルに合計を出す場合です。 Sub Sample1() Dim i As Long, k As Long, vL1, vL2 On Error Resume Next i = Cells(Rows.Count, "A").End(xlUp).Row Range(Cells(2, "F"), Cells(i, "F")).Formula = "=ROUND(A2,5)" vL1 = WorksheetFunction.Round(Range("E1"), 5) vL2 = WorksheetFunction.Round(Range("E2"), 5) i = WorksheetFunction.Match(vL1, Range("F:F"), False) k = WorksheetFunction.Match(vL2, Range("F:F"), False) Range("E3") = WorksheetFunction.Sum(Range(Cells(i, "B"), Cells(k, "B"))) Range("F:F").ClearContents End Sub ※ E1・E2セルが未入力等の諸々のエラーは考えていません。 こんな感じではどうでしょうか?m(_ _)m

tive005
質問者

補足

み、皆様ありがとうございます! これほど早くご回答頂けるとは思っておりませんでした! これから頂いた方法を試してみたいと思います!

  • mu2011
  • ベストアンサー率38% (1910/4994)
回答No.1

エクセル2007なので、SUMIFS関数を利用しては如何でしょうか。 仮にC2に開始時刻、D2終了時刻とすると、E2に=SUMIFS(B:B,A:A,">="&C2,A:A,"<="&D2) これをVBAでは次の様な感じです。  MsgBox Application.SumIfs([b:b], [a:a], ">=" & [c2], [a:a], "<=" & [d2])

関連するQ&A

  • マクロ:セルの範囲指定

    エクセルマクロで困っています。 セルの範囲指定をしようとしています。 初心者過ぎて、よくわかりません。 現在のマクロ↓ Sub 済() If ActiveCell.Column = 21 Then Selection.FormatConditions.Delete '条件付き書式削除 With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With ActiveCell.Offset(0, 1).Select With Selection.Interior .ColorIndex = 16 .Pattern = xlSolid End With '色変え判定セル書き換え ActiveCell.Offset(0, 5).Select ActiveCell.FormulaR1C1 = "77" ActiveCell.Offset(0, -5).Select Else answer = MsgBox("U列を選択して下さい", vbCritical) End If End Sub やりたい事は、下記の通りです。 列Uがアクティブの時にU~ACの行を塗りつぶし。 列は変動します。 今は、やり方がよく分からなかったため オフセットで一つ一つ塗りつぶしてます。 マクロを組みすぎてファイルが重くなって困っています。 回答よろしくお願いいたします。

  • エクセルで検索と貼り付けのマクロを組みたい

    エクセルで次のようなマクロを組みたいのですがうまくいきません。 ・C5からBB6の範囲において、Aという文字が入っているセルを検索し、その4行下1列右にコピーしておいたものを値だけ貼り付ける。 検索範囲を指定したいのは同じシート内に他にもAという文字が入っているセルがあるからです。このマクロを実行すると何故かC5からBB6の範囲以外のセルを選択し、貼り付けてしまいます。どこがいけないのでしょうか。ぜひ、教えてください。お願いします。 Range("C5:BB6").Select Cells.Find(What:="A", After:=ActiveCell, LookIn:=xlValues,LookAt:= _ xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _False, MatchByte:=False, SearchFormat:=False).select Selection.Offset(4, 1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=False

  • 日付が表示されているセルのみ範囲指定したい

    Excel2007でマクロ作成中の初心者です。 範囲指定がうまくいかない。 1)セルB30  =IF(A30="","",VLOOKUP(A30,表データ,2,FALSE))   セルB31  =IF(A30="","",VLOOKUP(A31,表データ,2,FALSE))    以下略  というように、セルB30~B60まで関数が入っており、  以下のように表示されています。  1   9月21日 2   9月22日    以下略    〃 29  10月19日 30  10月20日 31       ←(ここのセルは日付表示されず空欄。 関数 =IF(A60="","",VLOOKUP(A60,表データ,2,FALSE))が入っている) 2)以下のコードを実行すると Sub 範囲を選択() Range("B30").CurrentRegion.Select Selection.Resize(Selection.Rows.Count - 1).Select Selection.Offset(1, 0).Select Selection.Resize(Selection.Rows.Count - 1).Select End sub 1から31行まで選択されてしまします。これを30行目まで、日付の表示あるセルのみ 選択したいのですが、どうすればよろしいでしょうか

  • Excel VBA オートフィルの範囲指定

    Excel VBA で関数を入れたセルを最下行までコピー させたいのですが、範囲の指定がうまくできません。ごちゃごちゃ書きすぎて、よくわからなくなってしまいました。 実行してみたら、オートフィルのところでデバッグが出ました。 VBAはまだまだ初心者レベルです・・・ どこをどう直せばきちんと処理されるのか、どなたかお知恵をお貸しください。 (それと初めの定義は、Rangeで合ってるのでしょうか?) Sub sample() Dim MyCell1 As Range Dim MyCell2 As Range Dim MyCell3 As Range Dim MyCell4 As Range Dim MyCell5 As Range Set MyCell1 = Cells(5, Range("4:4").Find(what:="○○", searchorder:=xlByColumns).Offset(1, 1).Column) Set MyCell2 = Cells(5, MyCell1.Offset(0, 2).Column) MyCell1.Select Selection.Formula = "=$A5-" & MyCell2.Address(False, True) Set MyCell3 = Cells(5, MyCell1.Offset(0, -1).Column) Set MyCell4 = Cells(5, Cells(5, Columns.Count).End(xlToLeft).Column) Set MyCell5 = MyCell1.Offset(0, 1) MyCell5.Select Selection.Formula = "=" & MyCell3.Address(False, True) & "-" & MyCell4.Address(False, True) Range(MyCell1, Cells(5, MyCell1.Offset(0, 1).Column)).Select Selection.AutoFill Destination:=Cells(Cells(5, MyCell1.Column), Cells(Cells(Rows.Count, 1).End(xlUp).Row, MyCell5.Column)), Type:=xlFillCopy End Sub ********************* 下のような表に関数を入力して最下行までコピーさせたいです。  | A | B | C | D | E | F | G | H | I | J | K | L | -------------------------------------------------------------------------- 4 | code | name | 7/1 | 7/2 | ○○ |    |    | code|name| 7/1 | 7/2| ○○ | 5 |10000|aaaaaa| 15  | 20 | 35  |     |    |10001|bbbbbb| 13 | 25 | 38 |                           ((                            )) F5に "=$A5-$H5" と数式を入れてcodeを比較し、G5に "=$E5-$I5"と入れて数量を比較する。 F列とG列の入力されている最下行まで数式をコピーする。 ※毎月日数が変わり、商品数も変わるので、A列・B列・4行目以外は全て可変。 WindowsXP Excel2003 です。 よろしくお願いいたします。

  • エクセルマクロ非表示セル検索法について

    Findメソッドでセルを検索し、行及び列番号を求めたいのですが、セルを非表示にしておくと検索できず求めることが出来ません。 非表示セルも可能にするにはどうすれば良いのですか? 列番号 = Cells.Find("キー").Column  ' 失敗 列番号 = Rows(1).Find("キー").Column ' 失敗

  • EXCEL VBA 複数のセル位置を記憶したいで

    こんにちわ。 EXCEL VBAでセル位置記憶方法について質問させていただきます。 あるシート中で以下例の様に4つの規則性のないセル(cells(1,1) cells(3,2),cells(5,4),cells(2,5)に対してOFFSET処理を4回したいので、X1、X2、X3、X4に各セル位置を記憶させたいので以下のように記述しましたが、うまく動きません。 どなたかセル位置を変数に記憶させる方法をご教授いただけませんでしょうか? dim X1 dim X2 dim X3 dim X4 X1 = cells(1,1) X2 = cells(3,2) X3 = cells(5,4) X4 = cells(2,5) 例) Cells(X1).Select ActiveCell.Offset(0, 2).Select Cells(X2).Select ActiveCell.Offset(0, 2).Select Cells(X3).Select ActiveCell.Offset(0, 2).Select Cells(X4).Select ActiveCell.Offset(0, 2).Select よろしくお願い致します。

  • エクセル マクロ:文字変更

    教えてください。 sheet5にデータがあります。 マクロを実行すると、一番右の列のセルに○があると●と書き換える 一番右の列のセルに△があると▲と書き換えるコードを作成しています。 下記のコードでは時間がかかってしまいます。 省略 If Sheets("sheet5").Cells(r, cmax).Value = "○" Then Sheets("sheet5").Cells(r, cmax).Value = "●" 省略 AutoFilterを使用してマクロを作成しましたが、列に○と△が両方無いと 範囲指定したセルがすべて▲となってしまいます。 下記コードをどのように手直ししたらよいのか教えて頂けないでしょうか。 よろしくお願いします。 Sub 文字変更() Dim c As Integer Dim cmax As Integer Dim rmax As Long With Sheets("sheet5") rmax = .Range("A3").End(xlDown).Row cmax = .Range("A3").End(xlToRight).Column .Rows("1:1").Select Selection.AutoFilter For c = 2 To cmax Selection.AutoFilter Field:=c, Criteria1:="○" .Cells(1, c).Offset(1, 0).Select .Range(Selection, Cells(rmax, c)).Value = "●" Selection.AutoFilter Field:=c, Criteria1:="△" .Cells(1, c).Offset(1, 0).Select .Range(Selection, Cells(rmax, c)).Value = "▲" Selection.AutoFilter Field:=c Next c End With Selection.AutoFilter End Sub

  • エクセルVBAで範囲の指定をしたいです(初心者)

    エクセルVBAで範囲の指定をしたいです(初心者) 列AからJがデータが入る範囲です。 列AとBとCには必ず数値等が何かしら入ります。 列Dは常に空白です。 列E以降は何か入ることも入らないこともあります。 7行目までデータがある場合、 A1セルからこの場合はJ7セルまでを範囲指定したいのですが 行数は未定なので、 Range("A1").Select Range(Selection,Selection.End(xlDown)).Select でA列のデータ最終行まで下がり、そこから9つ右の列までを 範囲指定するというのがよくわかりません。 自動記録で絶対参照と相対参照を切り替えてやってみたのですが、 どうしても Range(Selection, Selection.End(xlDown)).Select ActiveCell.Range("A1:J7").Select と常にA1からJ7が指定になってしまいます。 バージョンは2003です。 つたない質問文で申し訳ありませんが、 どなたか宜しくお願いいたします。

  • ExcelVBA 選択された列のセルを指定する

    簡単かなと思ったら意外と出来ず、調べても出てこなくて思わぬ苦戦を強いられてしまい、 質問させて頂きます。 列をまるごと選択している状態で、その選択している列のセルを指定するには どうしたらいいでしょうか? とりあえず目的としてはシート1のA列を選択した状態で、 列の先頭(A1)の値をシート2に移す事としております。 以下、エラーになってしまったコードです 列選択でOffsetを使用した為のエラー? Worksheets("sheet2").Cells(1,1).Value = Worksheets("sheet1").Columns(1).Offset(0, 0).Value 選択してない状態でSelectionを使用した為のエラー? Worksheets("sheet2").Cells(1,1).Value = Worksheets("sheet1").Columns(1).Selection(1).Value 上手く動いたコード Application.Goto Worksheets("sheet1").Columns(1) Worksheets("sheet2").Cells(1,1).Value = Selection(1).Value Application.Goto でシート1のA列を指定してからSelectionで一つ目のセルを指定すれば出来ました しかし、大量のデータを扱う時にいちいち範囲選択していたら処理が遅くなると思われますし、 コード自体もスッキリしないのでいまいち納得がいきません。 1行で「Worksheets("sheet1").Columns(1).●●●」と続くメソッドの様な、スッキリできる方法は 無いのでしょうか? どなたかご教授お願いいたします。 当方Excel2003を使用しております。 宜しくお願い致します。

  • excel VBAの検索マクロを、OOo CALCで動かしたいのですが

    excel VBAの検索マクロを、OOo CALCで動かしたいのですが、、、 お助けください。VBA素人で、OOo BASICは全くわからない者です。よろしくおねがいします。 シート1を検索データの入力及び検索結果の表示画面として使い、 シート2に検索先のデータが入力されています。 検索先のデータは乱雑に入力されており、探したいデータが複数の列に点在し、 かつ、ひとつのセルにふたつのデータが入っていることもあります。 部分一致検索で、EXCELの検索機能の「次を検索」ボタンと同じ機能を果たすように作ったつもりです。 データが見つかった場合、シート2のデータをシート1にコピーするようになっています。 ソフトウェアのバージョンはcalc2.0と3.0です。 Excelでは動いているのですが、どう変えればcalcで使えるようになりますでしょうか? --------------------------------------------- Sub kensaku() 'sheet1のC4に検索したいデータを入力済 Dim A Set A = Range("sheet1!C4") Dim B As Range 'シート2を選択。 Sheets("sheet2").Select 'A1:S800の範囲をAの値で検索。 Set B = Range("A1:S800").Find(What:=A, _ after:=ActiveCell, SearchDirection:=xlNext, _ LookAt:=xlPart, MatchCase:=False, _ MatchByte:=False, SearchFormat:=False) '分岐 '見つからなかった場合、シート1の関数参照先のセルをクリアしてリセット。 If B Is Nothing Then MsgBox "見つかりません" Sheets("sheet1").Select Range("C2").ClearContents '見つかった場合、処理を続行する。 Else B.Activate 'A列へ移動。場合により空白セルを超える必要があるため10回繰り返す。 Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select Selection.End(xlToLeft).Select 'A列からC列へ移動すると目的のデータが入った列に到達。 Selection.Offset(0, 2).Select 'その値をコピーしてシート1のC2へ貼付(関数の参照先) Selection.Copy Sheets("sheet1").Select Range("C2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False '範囲選択を解除 Application.CutCopyMode = False 'sheet2のアクティブセルを次の検索開始位置(16列右)へ移動 (条件に一致する次のデータを検索するため) Sheets("sheet2").Select Selection.Offset(0, 16).Select 'シート1に戻る Sheets("sheet1").Select End If End Sub

専門家に質問してみよう