• ベストアンサー

ExcelVBAで次のコードを説明して欲しい

教えてください。下の表があります。 コード 数量 327 3 327 2 332 5 332 8 332 9 336 5 336 6 標準モジュールに次のようにコードが書いてあります。 Sub コード別集計とグループ化() Dim d As Long Dim s As String d = Cells(1, 1).CurrentRegion.Rows.Count s = "a1:b" & d Range(s).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2) End Sub 他人が作ったものです。動作は支障ありません。VBAを勉強中なのですが、なぜ、このように記述するのか分かりません。できるだけ詳しく解説していただけないでしょうか。 特に分からないのが s = から始まるところと、Range(s).～のところです。賢者の皆様よろしくお願いします。

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

  • ベストアンサー
  • BlueRay
  • ベストアンサー率45% (204/453)
回答No.3

>なぜコードの変わり目を取得できるのでしょう。 「327,332,336」をそれぞれに集計って事ですね。 >なぜコード+合計と表示できるのでしょう。 「327 計,332 計,336 計」を表示って事ですね。 >想像するに、ExcelVBAに定型的な機能としてプログラム化してある。…省略 ↓↓↓ この「コード別集計とグループ化」という処理は、対象範囲の自動検索と メニューバーの「データ」→「集計」をの処理を行っています。 対象範囲の自動検索の処理は、 >d = Cells(1, 1).CurrentRegion.Rows.Count >s = "a1:b" & d です。 集計の処理は、 >Range(s).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2) です。 集計には、コード別にと言う処理を行う事ができる(定型的な)機能が元々あるんです。 >勉強すれば誰でも簡単に作れるものなんでしょうか。 これをですよね？ ↓ >Range(s).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2) もちろん、勉強すればご自分で作る（マクロでですよね？）事も可能ですし、 もっと高機能なもの（？）まで作る事も可能です。

shonenA
質問者

お礼

いろいろとお教えいただきありがとうございました。 私にとって、このサイトはとても重宝しています。過去にも多くの賢者の皆様に教えをいただきました。私には VBA をいとも簡単に作ってしまう方々が天才か魔法使いのように思えます。しかも無料というのがうれしいです。また、お伺いしますのでよろしくお願い申し上げます。

その他の回答 (2)

  • BlueRay
  • ベストアンサー率45% (204/453)
回答No.2

Sub コード別集計とグループ化() 　　Dim d As Long 　　Dim s As String 　　'コメント(1) 　　d = Cells(1, 1).CurrentRegion.Rows.Count 　　'コメント(2) 　　s = "a1:b" & d 　　'コメント(3) 　　Range(s).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2) End Sub コメント (1)セルA1から下方に空白が見つかるまで検索。空白が見つかった時点でその前行を最終行としてdへ格納。ここでは7 (2)処理対象範囲をsへ格納。左上[a1]から右下[b?]を処理対象範囲として定義。ここでは、7行なのでb7となる。 (3)2で確定した範囲を集計対象として、グループ化を行う。 　グループ化する対象の列は、1(A列)で集計方法はxlSum(合計算出)で集計される列は2(B列)となる。 　(※GroupBy:対象列は1(A列)　Function:集計方法はxlSum(合計算出)　TotalList:集計される列は2(B列)) 以上で如何でしょうか。

shonenA
質問者

お礼

先日につづいてのご教示、感謝いたします。 >※GroupBy:対象列は1(A列)　Function:集計方法はxlSum(合計算出)、TotalList:集計される列は2(B列)) 少し分かったような気がします。それにしても VBA ってすごいですね。私の能力ですとある程度理解するまで３年以上かかりそうです。ありがとうございました。

shonenA
質問者

補足

なぜコードの変わり目を取得できるのでしょう。 なぜコード+合計と表示できるのでしょう。 想像するに、ExcelVBAに定型的な機能としてプログラム化してある。でしょうか。このプロシージャを作った人は天才なんでしょうか。それとも勉強すれば誰でも簡単に作れるものなんでしょうか。

  • MSZ006
  • ベストアンサー率38% (390/1011)
回答No.1

d = Cells(1, 1).CurrentRegion.Rows.Count これはデータの入っている行数を数えてｄに格納しています。ご質問の例では７になります。 s = "a1:b" & d これはSにデータの範囲を格納しています。ご質問の例では"a1:b7"という範囲になります。 Range(s).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2) 先ほど取得した範囲S（"a1:b7")でsubtotalをしています。 GroupBy:=1　１列目(a列)をキーにする Function:=xlSum　合計する TotalList:=Array(2)　二列目(b列)を合計する要素とする あまり詳しく判っていませんので間違っていたらすみません。

shonenA
質問者

お礼

早速のご回答感謝いたします。 S="a1:b" & d までは分かりました。質問の例は簡略化してありますがこのプロシージャを実行すると、コードの変わり目ごとに行が挿入されて、327合計、5 と表示されます。最後の行に総計と表示されます。しかもコードごとにグループ化されます。行の挿入や合計、総計の記述をした覚えがないのに…、たった１行でこんなことできるなんて VBA ってほんとにすごいと思いました。また、教えてください。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • エクセル　VBA　集計方法

    各シート毎に下記の内容にて集計をしたいのですが、Ａ２のセルにデータがない場合集計をしない方法がわからないのでご存じの方宜しくお願い致します。 Sheets("Sheet1").Select Range("A1:P62").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin, DataOption1:=xlSortNormal Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(16), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True Sheets("Sheet2").Select Range("A1:P62").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin, DataOption1:=xlSortNormal Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(16), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True Sheets("Sheet3").Select Range("A1:P62").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlPinYin, DataOption1:=xlSortNormal Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(16), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True End Sub

  • excelVBAコードを教えていただけませんか

    excel2000です。 下記コードが簡単そうと思いつつ、いざやろうとすると自分では作ることができず投稿させていただきました。どうかご教授の程よろしくお願いいたします。 excel2000 VBAのコードを教えていただけませんか ・「差し込み表示.xls」から「実験データ」へ値を読みに行き、表示させようとしています。 一日だけの日付をする場合は、下記に記載しているようなコードで対応できるのですが、月を指定して、30(31)日分のデータを読みにいく場合、どういうコードに変更していいか分からず、投稿させていただきました。 ■やりたいこと ・年月を「差し込み表示」のＥ１セルに記載して、データ読み込みを押すと、したのＮＯ１～３１(日付をあらわしています）にそれぞれ対応する値を表示させたい。 ■現物ファイル 現物ファイルを、下記にＵＰさせて頂きました。差し支えなければ確認いただけると幸いです。よろしくお願いいたします。 ■アップローダー 投稿NO4662 http://www.kent-web.com/pubc/book/test/uploader/uploader.cgi ■一日で読み込むときのプロシ－ジャー Sub datatyuusyutu() Const sashikomiDisplay As String = "差し込み表示.xls" Const dataFile As String = "実験データ.xls" Dim i As Long Dim j As Long Dim k As Long Dim objectionrow As Long Dim lastRow As Long Dim targetDate As String Dim targetTime As String Dim data(1 To 43) As Double Dim dataFindFlag As Boolean Dim 対象フォルダ As String '検索する年月日を取得 targetDate = Range("E5").Value 対象フォルダ = ThisWorkbook.Path & "\" Workbooks.Open 対象フォルダ & dataFile lastRow = Cells(Rows.Count, "B").End(xlUp).Row 'B列の最終行を得る '年月日で検索 For i = 2 To lastRow If Cells(i, 2) = targetDate Then Cells(i, 2).Select dataFindFlag = True For k = 1 To 43 data(k) = Val(Cells(i, k)) Next k Exit For End If Next i Windows(sashikomiDisplay).Activate With Workbooks(dataFile) If dataFindFlag = True Then Cells(1, 2) = data(1) Cells(12, 3) = data(4) Cells(14, 6) = data(5) MsgBox "実行しました" Else MsgBox "データがありません" End If End With Workbooks(dataFile).Close savechanges:=False End Sub

  • ExcelにおけるVBAで、データの振り分けをしたい

    Sub a() Dim i As Long Dim s As Long Dim b As Worksheet Dim c As Worksheet Dim maxi As Long Dim maxs As Long Application.ScreenUpdating = False With ThisWorkbook Set b = .Worksheets("bbb") Set c = .Worksheets("ccc") End With maxi = b.Range("A1").CurrentRegion.Rows.Count maxs = c.Range("A1").CurrentRegion.Rows.Count For i = maxi To 2 Step -1 For s = maxs To 2 Step -1 If c.Cells(s, 1) = b.Cells(i, 1) And c.Cells(s, 2) = b.Cells(i, 2) Then c.Cells(s, 14) = b.Cells(i, 3) End If Next s Next i Application.ScreenUpdating = True End Sub ワークシートcとワークシートbの1列目と2列目が一致したときにだけ、cの14列目にbの3列目のデータを代入したく思い、以上のようなコードを書きましたが、重くて終わる様子がありません。 ・そもそもあっているのか、あっていないならどこを修正すればよいか ・早く終わるようにするにはどうしたらいいか アドバイスをよろしくお願いします。

  • 引数付のFuncitonプロシージャと引数付のSUBプロシージャの違い

    親プロシージャに数値を渡すときに、引数付のFuncitonプロシージャと引数付のSUBプロシージャは、結果を見ると同じ動きをするように思います。 このような場合、両者には、どのような違いがあるのでしょうか？ Sub 親プロシージャ（） Cells(1,MyNOend)=123 end Sub ・子プロシージャ Function FMyRowCnt(MyNOend As Integer) MyNOend = TMYKanriBkWs1.Range("D1").CurrentRegion.Rows.Count End Function Sub FMyRowCnt(MyNOend As Integer) MyNOend = TMYKanriBkWs1.Range("D1").CurrentRegion.Rows.Count End Sub 以上　よろしくお願い致します。

  • CollectionとArrayの呼び出し順

    こんばんは。 いつも勉強させてもらっています。 ご教授ください。 セル範囲Ａ１：Ｂ３に適当な値を入れ 下記のコードを実行してみました。 ----------------------------------------------- Sub Test() 　　Dim Rng As Range 　　Dim myRange As Range 　　Set myRange = Range("A1").CurrentRegion 　　　　For Each Rng In myRange 　　　　　　Debug.Print "Collection: " & Rng.Value 　　　　Next Rng 　　Dim Ary 　　Dim myArray 　　 　　myArray = Range("A1").CurrentRegion.Value 　　　　For Each Ary In myArray 　　　　　　Debug.Print "Array: " & Ary 　　　　Next Ary End Sub ----------------------------------------------- その結果、 Collectionの場合は、　A1>B1 >A2>B2 >A3>B3 Arrayの場合は、　　　A1>A2>A3 >B1>B2>B3 の順で呼び出されました。 なぜこのような違いがでるのか分かりません。 教えてください。 宜しくお願いします。 　　

  • 調子よく使用していたコードが、急にエラーに！

    Windows XP　Home Edition Excel　2002 つい最近、ご回答して頂いたコードです。 オートフィルタ（▼）がかかった、直上のセルに色を付けるために使用しておりました。 どの行でも、どこでも実行できておりました。 大変、調子がよく使用していたのですが、 本日、下記のようにエラーとなり、動作しなくなってしまいました。 原因の一つは、 当方が、 EntireRowにてオートフィルタ（▼）をかけた場合に、 １、　256列全てにオートフィルタ（▼）がかかる。 ２、　Range("A1").CurrentRegionのようにデータがある列までオートフィルタ（▼）がかかる。 のように、２通りの結果となります。 １の時にエラーとなるようです。 Range("A1").CurrentRegion にてオートフィルタ（▼）をかけた場合は、 下記コードはきちんと動作します。 １となってしまうのは、当方の、ブックに何か原因があるのでしょうか。 １の場合でも動作させることはできますでしょうか。 当方のデータシートは、データがとんでいる所がありますので、 Range("A1").CurrentRegionでうまくオートフィルタ（▼）がかからない場合があります。 下記★箇所がエラーとなります。 一般的ではない質問かと思いますが、 何卒、ご教示お願い致します。 '------------------------------- 実行時エラー'424' オブジェクトが必要です。 と表示されます。 '------------------------------- Sub Worksheet_Calculate() Static rng As Range 　　Dim i As Long 　　Dim j As Long 　　If ActiveSheet.AutoFilterMode Then 　　　　With ActiveSheet.AutoFilter 　　　　　　If .Range.Rows(1).Row = 1 Then 'タイトル行が1行目の場合 　　　　　　　　j = 0 　　　　　　Else 　　　　　　　　j = -1 　　　　　　End If 　　　　　　For i = 1 To .Range.Rows(1).Cells.Count 　　　　　　　　If .Filters(i).On Then 　　　　　　　　　　.Range.Rows(1).Offset(j, i - 1).Interior.ColorIndex = 33 　　　　　　　　Else 　　　　　　　　　　.Range.Rows(1).Offset(j, i - 1).Interior.ColorIndex = xlNone　　'★ 　　　　　　　　End If 　　　　　　Next i 　　　　　　Set rng = .Range 　　　　End With 　　Else 　　　　If Not rng Is Nothing Then 'リセット（ただしできないことがある） 　　　　　　rng.Rows(1).Offset(j).Interior.ColorIndex = xlNone 　　　　End If 　　　　Set rng = Nothing 　　End If End Sub

  • ＶＢＡ　マクロ実行にてエラーが出ますが、原因を教えてください

    下記コードを実行すると、myCell.Selectのところで 実行時エラー’91’ オブジェクト変数またはWithブロック変数が設定されていません。 というエラーが出るのですが、どうすれば対策出来るのでしょうか？ Sub test() Dim i As Long Dim myCell As Range With Range("A1").CurrentRegion For i = 2 To .Rows.Count Step 2 If i = 2 Then Set myCell = .Rows(i) Else Set myCell = Application.Union(myCell, .Rows(i)) End If Next i End With myCell.Select End Sub

  • エクセル　マクロで行削除のコードについての質問です

    ある指定のセル範囲が空白ならその行自体を削除したいですが 上手くいきません。 記述したコードは以下の通りです。 Sub A01() Dim IRow As Long Dim d As Variant, i As Variant d = InputBox("抽出する日数を入力してください", "日数") If d = "" Then Exit Sub lRow = Cells(Rows.Count, 1).End(xlUp).Row For i = lRow To 2 Step -1 If ActiveSheet.Range(Cells(i, 5), Cells(i, d)) = Empty Then ActiveSheet.Rows(i).EntireRow.Delete End If Next End Sub Ifの判定の部分でエラーが出ます。 どう修正したらよいかご教示願います。

  • エクセルのマクロ実行→オブジェクトがはみでるエラーについて

    エクセルでマクロを作り、実行したのですが、データを集計し「2」で集約する部分で「オブジェクトからはみでます」というエラーがでます。原因がわかりません。正しく実行できる方法を教えてください。 Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(3, 4, 5, 6, _ 7, 8, 10, 13), Replace:=True, PageBreaks:=False, SummaryBelowData:=False Range("D2").Select 　　↓この部分でエラーになります。 ActiveSheet.Outline.ShowLevels RowLevels:=2 Range("A2").Select Selection.Insert Shift:=xlDown Range("P2:R2").Select Selection.Insert Shift:=xlDown Range("B1").Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy

  • Excel2013 ExcelVBAで散布図

    Excel2013 ExcelVBAで散布図を書く方法を教えてください。 Excel2013にてA列とC列で散布図を作成するため excelVBAで以下のコードを書いています。 Sub hogehoge() Dim aa As Range Dim cc As Range Dim aacc As Range Set aa = Range(Cells(1, 1), Cells(6, 1)) Set cc = Range(Cells(1, 3), Cells(6, 3)) Set aacc = Union(aa, cc) aacc.Select ActiveSheet.Shapes.AddChart.Select ActiveChart.ChartType = xlXYScatterLinesNoMarkers End Sub 上記を実行すると左側のグラフになってしまうのですが 右側のグラフを書きたいんですがどうしたらいいのでしょうか？ よろしくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する