Ｐａｇｅ 235 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼任意の箇所の平均のループについて みかちん 02/10/20(日) 23:27 ┣Re:任意の箇所の平均のループについて ichinose 02/10/21(月) 9:33 ┣Re:任意の箇所の平均のループについて yu-ji 02/10/21(月) 9:58 ┗Re:任意の箇所の平均のループについて みかちん 02/10/21(月) 22:37 ─────────────────────────────────────── ■題名 ： 任意の箇所の平均のループについて ■名前 ： みかちん ■日付 ： 02/10/20(日) 23:27 -------------------------------------------------------------------------
| こんにちは、始めまして皆様。 早速ですが質問させてください。 データの平均をとりたいのですがVBAでどのようにループをさせたら 任意の箇所を選択できるでしょうか？ データはこんな感じです。 ----------------------- A列 B列 1行 1 1 2行 2 1 3行 3 0 4行 4 0 5行 5 1 6行 6 1 7行 7 1 8行 8 0 ----------------------- A列：任意の数字 B列：1か0の値 B列は1か0の値なので1が続いた所までの範囲で A列のデータの平均を取り、次に0が続いた所までの範囲で またA列のデータの平均を取ることをデータがある限り 続けたいのです。 上記の例では下記の平均をとることを目標とします。 averege(A1:A2) averege(A3:A4) averege(A5:A7) averege(A8:A8) やりたいことは単純なのですがうまく説明できたでしょうか？ （きちんと伝わることを信じて）なにとぞ良いアイディアを お教え下さい。よろしくお願いします。 |
| ▼みかちん さん： おはようございます。 >こんにちは、始めまして皆様。 >早速ですが質問させてください。 >データの平均をとりたいのですがVBAでどのようにループをさせたら >任意の箇所を選択できるでしょうか？ > >データはこんな感じです。 >----------------------- > A列 B列 >1行 1 1 >2行 2 1 >3行 3 0 >4行 4 0 >5行 5 1 >6行 6 1 >7行 7 1 >8行 8 0 >----------------------- >A列：任意の数字 >B列：1か0の値 > >B列は1か0の値なので1が続いた所までの範囲で >A列のデータの平均を取り、次に0が続いた所までの範囲で >またA列のデータの平均を取ることをデータがある限り >続けたいのです。 > >上記の例では下記の平均をとることを目標とします。 >averege(A1:A2) >averege(A3:A4) >averege(A5:A7) >averege(A8:A8) > >やりたいことは単純なのですがうまく説明できたでしょうか？ >（きちんと伝わることを信じて）なにとぞ良いアイディアを >お教え下さい。よろしくお願いします。 作業用の列として､Ｃ列とＤ列を使いましたが､別の列でも構いませんが、 Offsetの位置だけ変更してください。 '============================================================= Sub test() Dim r1 As Range Dim r0 As Range Dim ra As Range Set ra = Range(Range("b1"), Range("b65536").End(xlUp)) With ra.Offset(0, 1) .Formula = "=if(b1=0,"""",1)" .Value = .Value End With Set r0 = Range(Cells(1, 2), Cells(Range("b65536").End(xlUp).Row, 2)).Offset(0, 1).SpecialCells(xlCellTypeBlanks) Set r1 = Range(Range("b1"), Cells(Range("b65536").End(xlUp).Row, 2)).Offset(0, 1).SpecialCells(xlCellTypeConstants, xlNumbers) Call セル範囲取得と並べ替え(Range(r0.Address & "," & r1.Address).Offset(0, -2), Range("d1")) i = 1 Do While Cells(i, 4).Value <> "" MsgBox WorksheetFunction.Average(Range(Cells(i, 4).Value)) i = i + 1 Loop Range("c:d").ClearContents End Sub '===================================================================== Sub セル範囲取得と並べ替え(rng As Range, outrng As Range) Dim セル範囲() As String セル範囲() = Split(rng.Address, ",") For i = LBound(セル範囲()) To UBound(セル範囲()) Cells((i + 1), 4).Value = セル範囲(i) Next Range(outrng, Cells(UBound(セル範囲()) + 1, outrng.Column)).Sort Key1:=outrng, Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ :=xlPinYin End Sub 簡単なテストしかしていませんが、動いています。 |
| 既にichinoseさんが回答されてるので、不要だと思いますが、 折角テストしたので（^^; 一応、こんな感じでも出来ますよってことで。 Function test() Dim Sum As Long Dim Sum_Cnt As Long Dim Current_B As Integer Dim cnt As Long '初期化 Sum = 0 Sum_Cnt = 0 cnt = 1 Current_B = Range("b1") '現在のBの値を保存 Do Until Range("b" & cnt) = "" 'データがなくなるまで If Range("b" & cnt) = Current_B Then '保存してあるBと同じ値の場合 Sum = Sum + Range("a" & cnt) '合計 Sum_Cnt = Sum_Cnt + 1 'カウント Else '保存してあるBと違う値になったら Range("c" & cnt - 1) = Sum / Sum_Cnt '平均を求める '初期化 Sum_Cnt = 1 Sum = Range("a" & cnt) Current_B = Range("b" & cnt) End If cnt = cnt + 1 Loop Range("c" & cnt - 1) = Sum / Sum_Cnt '最後の平均を求める End Function |
| ichinoseさん、yu-jiさん 早速教えてくださってありがとうございます。 コピー＆ペーストで両方とも動きました！！ 初心者なのでお二人のお答えを１行ずつゆっくり 解釈して、勉強させていただきますね。 それにしてもこんな短期間で考えてしまうなんてスゴイですね。 私ももっと頑張って皆様のお役に立てるようになりたいなぁ･･ |