エクセルVBA 平均を可変で求めたい

このQ&Aのポイント
  • エクセルVBA初心者が可変で平均を計算する方法を教えてください。
  • 為替の5日移動平均線を求めたいが、コードがうまく可変で平均を計算してくれません。
  • 現在のコードでは1日目の平均をずっと継承してしまいます。どのようにすれば可変になるでしょうか?
回答を見る
  • ベストアンサー

エクセルVBA 平均を可変で求めたい

はじめましてエクセルVBA初心者です。 為替の5日移動平均線を求めたいとおもっております。 以下のようなコードを書いていますが、可変で平均を計算してくれません。※1日目の平均をずっと継承してしまいます。 どのようにすれば、これを可変にできますでしょうか。 ご教示、宜しく御願いいたします。 Const AVHI1 As Integer = 5 ~ 省略 ~ '最終セル Cells(65536, 1).End(xlUp).Select endrh = ActiveCell.Row Range("A2").Select ~ 省略 ~ 'AVHI1(5日)の終値平均 ------------------------------------------ avhi = AVHI1 + 1 Range(Cells(2, 16), Cells(endrh - AVHI1, 16)) = WorksheetFunction.Average(Range("F2:F " & avhi & "")) Range("G1").Select

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

  • ベストアンサー
  • o_chi_chi
  • ベストアンサー率45% (131/287)
回答No.4

平均取得範囲が誤っています。 Range(Cells(2, 16), Cells(endrh - AVHI1, 16)) = WorksheetFunction.Average(Range("F2:F " & avhi & "")) この場合"F2"から"F6"で5セル分の平均となっていますが Range("P" & i) = WorksheetFunction.Average(Range("F" & i & ":F" & i + AVHI1)) この場合はiが2なら"F2"から"F7"(i+AVHI1)までの6セル分の平均となってしまっています。 avhi = AVHI1 - 1 For i = 2 To endrh - AVHI1 Range("P" & i) = WorksheetFunction.Average(Range("F" & i & ":F" & i + avhi)) Next i とすればOKです。 また小数点3位を四捨五入ならRound(値,2)とすればできます。

melon00
質問者

お礼

o_chi_chiさん うまくいきました! ありがとうございます!

その他の回答 (3)

  • o_chi_chi
  • ベストアンサー率45% (131/287)
回答No.3

ワークシート関数を範囲指定したセルへ設定すると自動でセルの位置を変えて設定してくれますが、 ワークシート関数を利用して計算結果だけをセルへ設定しているので同じ値が入るのは当然です。 For~Next等で繰り返す必要があります。 --- For i = 2 To endrh - AVHI1 Range("P" & i) = WorksheetFunction.Average(Range("F" & i & ":F" & i + avhi)) Next i

melon00
質問者

補足

o_chi_chiさん ありがとうございます。 ほぼ希望通りのものができました。 ただ、一点困っているのは、5日(当日を含む)の平均を求めているのですが、どうも数値が違うようなのです、色々と何が違うのかを見ていますが、皆目原因がわかりません。 また、小数点第2位まで表示させていますが、なぜか第3位が繰上げされてしまうようです。例)正;210.86 誤:210.87 どうしたものでしょうか。。 折角ほぼ希望通りだったのですが、小さなところで違います。 avhi = AVHI1 + 1 For i = 2 To endrh - AVHI1 Range("P" & i) = WorksheetFunction.Average(Range("F" & i & ":F" & i + AVHI1)) Next i Range("G1").Select

  • AKARI0418
  • ベストアンサー率67% (112/166)
回答No.2

WorksheetFunction.Average(Range("F2:F " & avhi & "")) の範囲指定を変えればよいということでしょうか? 書き方を変えると以下のようになります。 WorksheetFunction.Average(Range(Cells(2,6),Cells(avhi,6)) 書式はRange(開始セル,終了セル)となります。 Cells(行番号,列番号)です。

  • okormazd
  • ベストアンサー率50% (1224/2412)
回答No.1

でしょう。 だから、 http://okwave.jp/qa4638914.html でいったでしょう。 あなたの言う可変で平均を求めるようにはできますが、繰り返し計算になって、一つずつ計算してセルに入れるから、時間がかかってダメだと。 ワークシート関数は早いけど、数多くやったらやはり時間がかかりますよ。65000もやって御覧なさい。なかなか返ってこないから。 http://okwave.jp/qa4638914.html で私が言ったようにするのが実用的です。

関連するQ&A

  • エクセルVBAで平均を求める

    こんにちわ。 エクセルVBA初心者です。 質問1 VBAで平均を求めているのですが、セルに関数が入ってしまいます。 これを入らずに計算できるようにするには、どのようにすればよい でしょうか。 質問2 また、現状10000行まで計算できるようにしておりますが、本当は、 エクセルの限界まで(確か6万・・・行だったと思いますが)したい のですが、どうすればよいでしょうか。 【補足】 P、Q列に夫々、F列の5つ平均(P)、25つ平均(25)を表示させるVBEで作成しています。 ただ、P,Q列を見ていただけるとAverage関数が入っています。 できれば、これを入らないようにしたいのです。 【対象となっているコード】 ※ Module2に記載しています。 Const AVHI1 As Integer = 5 '移動平均日数1 可変にしなければ Const AVHI2 As Integer = 25 '移動平均日数2 可変にしなければ Sub 移動平均() Dim endrh As Integer '最終セル Application.ScreenUpdating = False Worksheets("date").Select 'セル表示形式 Columns("P").Select Selection.NumberFormatLocal = "0.0_ " Columns("Q").Select Selection.NumberFormatLocal = "0.0_ " Range("G1").Select '最終セル Cells(10000, 1).End(xlUp).Select endrh = ActiveCell.Row Range("A2").Select 'データチェック If endrh - AVHI2 < 4 Then MsgBox "移動平均" & AVHI2 & "日分のデータ不足で計算できません" Exit Sub End If 'AVHI1(5日)の終値平均 ------------------------------------------ avhi = AVHI1 + 1 Range(Cells(2, 16), Cells(endrh - AVHI1, 16)).Formula = _ "=AVERAGE(F2:F" & avhi & ")" 'ここをVBAに調整 Range("G1").Select 'AVHI1(25日)の終値平均 ------------------------------------------ avhi = AVHI2 + 1 Range(Cells(2, 17), Cells(endrh - AVHI2, 17)).Formula = _ "=AVERAGE(F2:F" & avhi & ")" 'ここをVBAに調整 Range("G1").Select Cells(1, 16) = AVHI1 & "_SMA" Cells(1, 17) = AVHI2 & "_SMA" Range("G1").Select End Sub

  • エクセルVBAについて

    こんにちわ! 今、エクセルでAシートの入力した項目をBのシートへデーターが入力できるようなシステムを以下のようにくみました。 そこでBシートにデーターが入力されるのですが20行まで入力すると入力できないようにしたいのですが、なかなか上手くいきません。 A1からF20まで書式のロックを外しそれ以外のセルは保護をかけたのですがその状態でVBAを使って20行以上入力できませんという感じのエラー表示をしたいのですが、どうすればいいでしょうか? VBAは初心者ですが宜しくお願いします。 Private Sub CommandButton1_Click() Dim row As Integer row = WorksheetFunction.CountA(Sheets("date").Columns(1)) + 1 Sheets("date").Cells(row, 1).Value = Range("B2").Value row = WorksheetFunction.CountA(Sheets("date").Columns(2)) + 1 Sheets("date").Cells(row, 2).Value = Range("B3").Value row = WorksheetFunction.CountA(Sheets("date").Columns(3)) + 1 Sheets("date").Cells(row, 3).Value = Range("B4").Value row = WorksheetFunction.CountA(Sheets("date").Columns(4)) + 1 Sheets("date").Cells(row, 4).Value = Range("B5").Value row = WorksheetFunction.CountA(Sheets("date").Columns(5)) + 1 Sheets("date").Cells(row, 5).Value = Range("B6").Value row = WorksheetFunction.CountA(Sheets("date").Columns(6)) + 1 Sheets("date").Cells(row, 6).Value = Range("B7").Value Sheets("統制入力").Select Range("B17").Select ActiveWindow.SmallScroll Down:=-9 Range("B3:B7").Select Selection.ClearContents Range("B1").Select End Sub

  • EXCEL VBA 早く処理をする

    よろしくお願いします 下の構文を標準モジュールに書き込み、callで実行しているのですが 処理に時間がかかります。 処理を早くする方法と構文の簡素化のご教示をお願いします。 Application.ScreenUpdating = False For i = 1 To 12 With Worksheets(i) .Select LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), order1:=xlAscending .Range("G8:G" & LastRow - 1).Formula = "=G7+E8-F8" LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A" & LastRow).Select Dim EndRow As Long EndRow = .Range("A" & Rows.Count).End(xlUp).Row Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = .Name & "合計" Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) = Application.WorksheetFunction.Sum(Range("E7:E" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) = Application.WorksheetFunction.Sum(Range("F7:F" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(2, 3) = "前月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) = .Range("G7") Cells(Rows.Count, 1).End(xlUp).Offset(2, 5) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 4) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 3) = "次月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(4, 3) = "合計" Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) - Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(4, 4) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) Cells(Rows.Count, 1).End(xlUp).Offset(4, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(1, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(2, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(4, 6) = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6) .Range("C7").End(xlDown).Select Selection.Offset(4, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 3).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 4).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(0, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin End With Next i Application.ScreenUpdating = True

  • 別のシートを参照して計算する方法

    質問です。 シート1に数値が入力してあり、そこで計算した結果をシート2に貼り付けるにはどのようにすればいいのでしょうか? Worksheets("シート2").Cells(3 + g, 3 * c) = _ Worksheets("シート1").Select.WorksheetFunction._ Average(Range(Cells(e, g + 2), Cells(f, g + 2))) と書いたのですが、上手くいきません。 おそらく Worksheets("シート1").Select.WorksheetFunction._ Average(Range(Cells(e, g + 2), Cells(f, g + 2))) の部分がおかしいと思うのですが、どうすればよいでしょうか? よろしくお願いします。

  • VBAでのエラー対処について

    現在仕事でVBAと悪戦苦闘しています。 下記のマクロを実行すると、実行時エラー'13':型が一致しません。 と表示されます。 初心者で対処法がわかりません。 よろしくお願いします。 Sub Macro1() dat = InputBox("検索値") Range("A1").Activate Cells.Find(What:=dat, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , MatchByte:=False, SearchFormat:=False).Activate gegyo = ActiveCell Do Cells.FindNext(After:=ActiveCell).Activate If dat = ActiveCell Then If gegyo = ActiveCell.Row Then End Rows(ActiveCell.Row - 1 & ":" & ActiveCell.Row - 1).Delete Shift:=xlUp Range("A" & ActiveCell.Row - 1).Activate Rows(ActiveCell.Row + 1 & ":" & ActiveCell.Row + 1).Delete Shift:=xlUp Rows(ActiveCell.Row & ":" & ActiveCell.Row).Delete Shift:=xlUp End If gegyo = ActiveCell.Row Loop End Sub

  • エクセルのVBAで

    現在アクティブであるセル(sheet2)に sheet1のあるセル範囲においての平均値を出しいのですが 条件文がわかりません。 以下に間違いのためにデバックしてしまう条件文を載せます。 BBはFor文で使っている関数です。 誰か分かりやすく解説してくださる硬いたらお願いします。 間違っている文 ActiveCell = "=AVERAGE(Sheet1!Range(Cells((BB - 1) * 6 + 3, 3), Cells((BB - 1) * 6 + 8, 3))/6"

  • エクセルVBA教えて下さい

    エクセルの表で -AB C D E F 1年月--1801 2------ 3------ 4------ (-)は空欄でセルE1=18、F1=1とします。 コントロールボックスをつかって Private Sub Command登録_Click() d1 = Range("A65536").End(xlUp).Row d2 = Range("B65536").End(xlUp).Row Cells(d1 + 1, 1) = Range("E1").Value Cells(d2 + 1, 2) = Range("F1").Value End Sub とすると、登録コマンドを押すたびに次々セルA,Bに同じ数値が登録されるのですが、一回登録した数値を2度登録できないようにする方法はありませんか?  要は、この表だと18と1という条件では、2度登録できないようにしたいのです。よろしくお願いします。

  • エクセルVBAですが、

    以下の意味を教えて下さい。 範囲を選択するのだとは思うのですが、それぞれの詳細が分からないので、知りたいのです。 1、 ActiveCell.SpecialCells(xlLastCell).Select 2、 Range(Selection, Cells(1)).Select 1・2についてよろしくお願いします。

  • EXCEL VBA----離れたセル範囲の指定

    こんにちは。初歩的なことで困っています。 Range("A3:A19,F3:F19").Select のように、離れたセル範囲を選択したいのですが 上の例の19行目が不定であるため、変数を使ったCellsプロパティを使用し i=Range("A3").End(xldown).Row Range("Cells(3, 1).Cells(i, 1), Cells(3, 6).Cells(i, 6)").Select と書いてみたのですが、エラーになってしまいました。 正しい指定の仕方を教えて下さい。よろしくお願いします。

  • エクセルVBAについて質問です

    お世話になります。 早速ですが、下記の構文を作成しましたが、Activecell.Rowの部分で悪さをし 上手く動きません。 行いたかった事としては、Functionにて関数を手作りしようと試みたのですが、 結局は壁にぶちあたってしまったって所です。。。 内容としては、エクセルが手動計算だった場合は、一回りで動作が終了するので 問題なく想定の値が叩き出されますが、自動計算にした途端に「別セルに入れた 計算式まで、Activecell.Rowに引きずられて計算をし、別の値に変わってしまう」 現象となってしまいました。。。(説明下手で済みません) Public Function Shotoku(houshu As Long) Dim ACcel As Variant Dim FR As Range With Worksheets("所得税月額表(平成24年分)") ACcel = houshu If ACcel < 88000 Then Shotoku = 0 Exit Function End If For Each FR In .Range("C13:C347") If ACcel < FR Then If Cells(ActiveCell.Row, 51) = 0 Then       ←問題の個所です Shotoku = .Cells(FR.Row, 4) ElseIf Cells(ActiveCell.Row, 51) = 1 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 5) ElseIf Cells(ActiveCell.Row, 51) = 2 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 6) ElseIf Cells(ActiveCell.Row, 51) = 3 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 7) ElseIf Cells(ActiveCell.Row, 51) = 4 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 8) ElseIf Cells(ActiveCell.Row, 51) = 5 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 9) ElseIf Cells(ActiveCell.Row, 51) = 6 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 10) ElseIf Cells(ActiveCell.Row, 51) = 7 Then    ←問題の個所です Shotoku = .Cells(FR.Row, 11) End If Exit For End If Next End With End Function 計算式を当て込んで、例えば2行目のIF文の条件に引っかかった場合、他の セルまでその行を読んでしまうので、条件が変わってしまう事態になってます。 イメージではActivecell.Rowがダメなんだと思いますが、これ以外のセル番地の 取得方法が分からなくって><; どなたかお助け願います!!!

専門家に質問してみよう