Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
中央平均値の算出について
投稿日時: 23/05/25 10:41:25
投稿者: ひろまさ

いつもお世話になっております。
ご教示をお願いしたい事がございます。
同一商品CDの作成時間に対して中央平均値を算出したいのですが、TRIMMEAN関数を
利用しています。(=TRIMMEAN(範囲,0.2))
それをVBAで自動化を行いたいのですが、同一商品CDの作成時間を範囲指定して、
中央平均値を算出する処理のアドバイスを頂けないでしょうか。
ネットで条件を色々と変更を行い検索をしていますが、それに近いサイトが確認
できないのでご質問をさせて頂きました。
 
以下が結果です。
商品CD 作成時間  中央平均値 
111    3
111    1
111    2   
111    4
111    5      3
222    5
222    4
222    2
222    1
222    3      3
 
よろしくお願い致します。

回答
投稿日時: 23/05/25 14:40:31
投稿者: simple

余り凝ったことをせずに、A列の商品CDを順次見て行ったらどうでしょうか。
 
・ブロックの始めの行番号を変数に記憶します。
・前の行の値と異なったら、そこは新しいブロックの始まりなので、
  そこまでの範囲の計算をして、結果を書きこみ、
・新しいブロック開始行を記憶します。
これを繰り返せばよいのではないでしょうか。
 
For .. Next ループで書けると思われます。
ご自分でトライしてみてください。
 
# なお、議論のやりとりが終了し、質問者さんが内容を確認できるまで、
# スレッドはむやみに終了させないほうがいいですよ。
# また、完成品をプレゼントする場でもなく、あくまで参考情報の提供ですから、
# 勘違いされないようにお願いします。

投稿日時: 23/05/25 15:20:05
投稿者: ひろまさ

simple様
今回もご回答を頂きありがとうございます。
 
なお、議論のやりとりが終了し、質問者さんが内容を確認できるまで、
スレッドはむやみに終了させないほうがいいですよ。
 
 ⇒ この件は承知しました。
   今後、気を付けます。
 
また、完成品をプレゼントする場でもなく、あくまで参考情報の提供ですから、
勘違いされないようにお願いします。
 
 ⇒ これについては承知しています。
   自分の為にもならないですし、質問形式はそのままではなく簡略した内容で
   ご質問をさせて頂いています。
   昨晩、ご教示して頂いたコードもそうですが、1つ1つ書籍とネットで検索を
   行いながら確認を行ない、かなり変更を行っています。
   ベースとなる記述をご教示して頂いて助かりました。
 
今回も簡略した形式でご質問をさせて頂き、午前から自身もFor .. Next ループで
挑戦しています。
いろいろとネット等で確認しましたがどうしても前に進めないのでご質問をさせて
頂いたのが経緯です。
試作を作るのに、既に同一商品CDの作成時間を範囲指定するところでつまずいており、
中央平均値の算出までたどりついていない状態です。
ご迷惑をお掛けして大変申し訳ございませんでした。

投稿日時: 23/05/25 17:37:22
投稿者: ひろまさ

誠に恐縮ではございますが、同一商品CDの作成時間を範囲指定する処理に
ついてもう少し詳しくご教示をお願いできないでしょうか。
また、TRIMMEAN関数はVBAでは利用は難しいでしょうか。
どうしてよいのか止まっていますのでよろしくお願い致します。

回答
投稿日時: 23/05/25 18:21:27
投稿者: simple

ワークシート関数は、頭にWorksheetFunctionまたはApplicationをつけると使えます。
例外的に使えないものもあります。(既にVBAに同等の機能がある場合(例:Left,Mid等))
WorksheetFunctionまたはApplicationではエラーに関する挙動が異なります。(調べてみて下さい)
 
参考コードを挙げておきます。

Sub test1()
    Dim lastRow  As Long
    Dim former   As Long
    Dim startRow As Long
    Dim rng      As Range
    Dim k        As Long

    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    former = Cells(2, "A")
    startRow = 2
    For k = 3 To lastRow + 1
        If Cells(k, "A") <> former Then    '新しい商品CD
            Set rng = Range(Cells(startRow, "B"), Cells(k - 1, "B"))
            Cells(k - 1, "C") = Application.TrimMean(rng, 0.2)
            former = Cells(k, "A")
            startRow = k
        End If
    Next
End Sub

投稿日時: 23/05/25 20:17:04
投稿者: ひろまさ

simple様
ご回答ありがとうございます。
望んでいた結果が表示されました。
コードの内容をしっかりと勉強して、利用するツールに応用
させてみます。
ありがとうございました。