• 締切済み

A列を検索し一致した行を表示。さらにそれらの平均を出す。

こんばんは、いつもお世話になっています。 今回は関数で出来るのかわからないんですが質問させてください。    A   B   C     商品名  個数 販売数 1 りんご  1   2 2 なし   3   5 3 ぶどう  7   9 4 りんご  2   4 上のようにSheet1に表があったとします。 A列の「りんご」を検索し、1行目と4行目を別シートに表示 その結果を下のように平均・最大・最小という風に表示したいのですが可能でしょうか?    A   B   C     商品名  個数 販売数 1 りんご  1   2 2 りんご  2   4 3  4 最大   2 5 最小   1 6 平均   2 実際はに作っている表の列は「Z」まであり、行も毎日入力するものなのでかなりの数になります。 自分でもいろいろ試してA列を=DGETで検索したのですが1つしか表示されなくてダメでした。 だめだめな自分にお知恵を貸してくださいm(_ _)m

みんなの回答

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.26

私もVBA勉強中です。 趣味でやっているだけなので気楽に 少しずつ覚えようと思っています。 私が良く参考にしているホームページを紹介します。 エクセルのヘルプがもっと使いやすかったら ヘルプだけでいいんですけどね~。 モーグ http://www.moug.net/index.htm よねさんのWordとExcelの小部屋~Excel(エクセル)VBA入門 http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/index.html Excel VBA 入門講座 http://excelvba.pc-users.net/ Let's Excel VBA http://www.sanynet.ne.jp/~awa/excelvba/kouza.html MilkHouse http://www6.plala.or.jp/MilkHouse/index.html Office TANAKA http://officetanaka.net/excel/index.htm Excelでお仕事 http://www.asahi-net.or.jp/~ef2o-inue/top01.html Shun's Page ~Excel VBA Parts Collection http://t_shun.at.infoseek.co.jp/My_Page/Excel-VBA/vba_menu.htm Excel講座 http://www.serpress.co.jp/excel/ ExcelVBAへの道 http://www.voicechatjapan.com/excelvba/index.html インストラクターのネタ帳 http://www.relief.jp/itnote/archives/cat_62.php EXCELノート http://park11.wakwak.com/~miko/Excel_Note/frame1.htm Visual Basic 中学校 http://homepage1.nifty.com/rucio/main/main.htm だるまのつぶやき~エクセルVBA小技集 http://hp.vector.co.jp/authors/VA033788/kowaza.html

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.25

ka_na_deです。 その他の気になる点も改良しましたので、 アップしておきます。 1点目:ダミーの空白列が丸出しにならないように     画面の更新を抑制 2点目:元データのシート名をSheet1でなくても     何でもOKとするように変更 3点目:抽出データと検索リストのシートも、自動で     作成し、事前に空白シートを準備しなくても     大丈夫なように変更 4点目:その他、細かな修正 '//--------------標準モジュールに記述----------------------------------------- Public MyKey As String Sub test9() On Error GoTo Err   Dim St1Rng As Range, St1Rng2 As Range, St2Rng As Range, St2Rng2 As Range   Dim St1 As Worksheet, St2 As Worksheet, St3 As Worksheet   Dim St1LastRow As Long, St2LastRow As Long, St2LastCol As Long   Dim CalcStartCol As Long, c As Long   Dim HeadLineNum As Long, KeyColumn As Long   Dim KeyColumnA As String, CalcStartColA As String                '=========ユーザー変更箇所=====================================(ここから)====   HeadLineNum = 3    '見出し行の数 (データ開始行番号-1)   KeyColumnA = "B"    '検索列   CalcStartColA = "E"  '計算開始列   '=========ユーザー変更箇所=====================================(ここまで)====     Set St1 = ActiveSheet '元データのシート              '(指定不要です。必ず元データを選択して実行してください)      KeyColumn = St1.Range(KeyColumnA & "1").Column    '検索列の列番号取得   CalcStartCol = St1.Range(CalcStartColA & "1").Column '計算開始列の列番号取得      Application.ScreenUpdating = False  '画面の更新を抑止   Sheet_Add ("検索リスト")     '検索リストのシートを追加作成   Sheet_Add ("抽出シート")     '抽出シートを追加作成   Set St2 = Worksheets("抽出シート")   Set St3 = Worksheets("検索リスト")   St1.Move Before:=St2     'ダミーの見出し行の挿入 (元の見出し行が結合されている場合への対応)   St1.Rows(HeadLineNum + 1).Insert Shift:=xlDown   '検索リストの作成   St3.Cells.Clear   With St1    St1LastRow = .Cells(.Rows.Count, KeyColumn).End(xlUp).Row    .Range(.Cells(HeadLineNum + 1, KeyColumn), .Cells(St1LastRow, KeyColumn)).Copy _       Destination:=St3.Range("A1")   End With   With St3    .Range("A1").Value = "リスト"    .Columns("A:A").AdvancedFilter _        Action:=xlFilterCopy, CopyToRange:=.Columns("B:B"), Unique:=True   End With      '見出し行+ダミー見出し行+データ領域   Set St1Rng = St1.UsedRange   'ダミー見出し行+データ領域 (オートフィルター領域)   Set St1Rng2 = St1Rng.Resize(St1Rng.Rows.Count - HeadLineNum).Offset(HeadLineNum)      'オートフィルターによる抽出   With St1Rng2    'フィルタ設定    .AutoFilter    If Not St1.AutoFilterMode Then .AutoFilter    '検索ワードの要求    UserForm1.Show    'キャンセル時の処理    If MyKey = "False" Or MyKey = "" Then     St1.Rows(HeadLineNum + 1).Delete  'ダミーの見出し行の削除     Exit Sub '終了    End If    '左端に空白列が存在するばあいへの事前対応    KeyColumn = KeyColumn - .Cells(1).Column + 1    'KeyColumn列を変数MyKeyでデータ抽出    .AutoFilter Field:=KeyColumn, Criteria1:=MyKey    '抽出シートの初期化    St2.Cells.Clear    '抽出データ(可視セル)をコピー&ペースト    .SpecialCells(xlCellTypeVisible).Copy _     Destination:=St2.Cells(HeadLineNum, .Cells(1).Column)    'フィルタ解除    .AutoFilter   End With   '見出し行のコピー&ペースト   St1.Rows("1:" & HeadLineNum).Copy Destination:=St2.Range("A1")   'ダミーの見出し行の削除   St1.Rows(HeadLineNum + 1).Delete   '最大、最小、平均の計算   With St2    St2LastRow = .UsedRange.Cells(.UsedRange.Cells.Count).Row  '最終行    St2LastCol = .UsedRange.Cells(.UsedRange.Cells.Count).Column '最終列    If St2LastRow - HeadLineNum <= 0 Then Exit Sub    '基準の計算領域    Set St2Rng = _       .Cells(1, CalcStartCol).Resize(St2LastRow - HeadLineNum).Offset(HeadLineNum)    .Cells(St2LastRow + 2, "A").Value = "最大"    .Cells(St2LastRow + 3, "A").Value = "最小"    .Cells(St2LastRow + 4, "A").Value = "平均"    For c = CalcStartCol To St2LastCol     Set St2Rng2 = St2Rng.Offset(, c - CalcStartCol)     If WorksheetFunction.Count(St2Rng2) > 0 Then      .Cells(St2LastRow + 2, c).Value = WorksheetFunction.Max(St2Rng2) '最大      .Cells(St2LastRow + 3, c).Value = WorksheetFunction.Min(St2Rng2) '最小      .Cells(St2LastRow + 4, c).Value = WorksheetFunction.Average(St2Rng2) '平均     End If    Next c    .Activate '   .Cells.Columns.AutoFit '列幅の自動調整(必要に応じて有効にして下さい)    .Range("A1").Select   End With      Application.ScreenUpdating = True '画面の更新を許可   '変数の解放   Set St1 = Nothing: Set St2 = Nothing:  Set St3 = Nothing   Set St1Rng = Nothing: Set St1Rng2 = Nothing   Set St2Rng = Nothing: Set St2Rng2 = Nothing   Exit Sub Err:  Application.ScreenUpdating = True  MsgBox "error" End Sub Sub Sheet_Add(StName As String)  Dim Scheck As Boolean  Dim St As Worksheet  Scheck = False  For Each St In Worksheets   If St.Name = StName Then    Scheck = True    Exit For   End If  Next  If Scheck = False Then   Sheets.Add.Name = StName  End If End Sub '//--------------ユーザーフォームモジュールに記述----------------- Private Sub UserForm_Initialize()  'ユーザーフォームの初期設定  Dim St3LastRow As Long    With Worksheets("検索リスト")    St3LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row '最終行  End With    With UserForm1   .Caption = "リストから選択してください"   .CommandButton1.Caption = "OK"   .CommandButton2.Caption = "CANCEL"   With .ComboBox1    .Style = fmStyleDropDownCombo    .RowSource = "検索リスト!B2:B" & St3LastRow    .ListIndex = -1   End With  End With End Sub Private Sub CommandButton1_Click()  'OKボタンが押された場合  MyKey = UserForm1.ComboBox1.Value  Unload Me End Sub Private Sub CommandButton2_Click()  'キャンセルボタンが押された場合  MyKey = "False"  Unload Me End Sub '----------シートモジュールに記述----------------------- Private Sub CommandButton1_Click()  Call test9 End Sub

ainouracho
質問者

補足

こんばんは、ka_na_deさん。 現在、早速職場のシートに導入し活用させていただいております。 今まで、検索しsubtotal等を用いて計算してたのが、ボタン一つで出来るようになり業務も効率化できました。 自分でも出来るようになればといいのですが・・・現在、本を購入し勉強しているところです。 今回は本当にありがとうございました。。

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.24

ka_ne_deです。 早速、改良しました。 1点目: すべて文字列の列は計算しないように修正 2点目: ユーザーフォームでキャンセルボタンを押した場合に      ダミーの見出し列が残る不具合を修正 3点目: ユーザーフォームで何も入力せずに「OK」を押した場合      にもキャンセルと同じ処理を行うように修正 4点目: 計算開始列を "E" のように指定しやすく変更      同様に、検索列も "B"のように指定しやすく変更      (前回の説明箇所が変わりました。) 尚、1点目の改良で、データ以外のところで塗りつぶしなどがあると エラーになるかもという心配も同時に解消されました。 Public MyKey As String Sub test8() On Error GoTo Err   Dim St1Rng As Range, St1Rng2 As Range, St2Rng As Range, St2Rng2 As Range   Dim St1 As Worksheet, St2 As Worksheet, St3 As Worksheet   Dim St1LastRow As Long, St2LastRow As Long, St2LastCol As Long   Dim HeadLineNum As Long, KeyColumn As Long   Dim CalcStartCol As Long, c As Long   Dim KeyColumnS As String, CalcStartColS As String     Set St1 = Worksheets("Sheet1") '元データのシート   Set St2 = Worksheets("Sheet2") '抽出するシート   Set St3 = Worksheets("Sheet3") '検索ワードリストのシート   HeadLineNum = 3    '見出し行の数 (データ開始行番号-1)   KeyColumnS = "B"    '検索列   CalcStartColS = "E"  '計算開始列      KeyColumn = St1.Range(KeyColumnS & "1").Column   '検索列の列番号取得   CalcStartCol = St1.Range(CalcStartColS & "1").Column '計算開始列の列番号取得     'ダミーの見出し行の挿入   St1.Rows(HeadLineNum + 1 & ":" & HeadLineNum + 1).Insert Shift:=xlDown     Set St1Rng = St1.UsedRange   'データ領域+ダミー見出し行   Set St1Rng2 = St1Rng.Resize(St1Rng.Rows.Count - HeadLineNum).Offset(HeadLineNum)     '検索ワードリストの作成   St3.Cells.Clear   With St1    St1LastRow = .Cells(.Rows.Count, KeyColumn).End(xlUp).Row    .Range(.Cells(HeadLineNum + 1, KeyColumn), .Cells(St1LastRow, KeyColumn)).Copy _       Destination:=St3.Range("A1")   End With   With St3    .Range("A1").Value = "リスト"    .Columns("A:A").AdvancedFilter _        Action:=xlFilterCopy, CopyToRange:=.Columns("B:B"), Unique:=True   End With     'オートフィルターによる抽出   With St1Rng2    'フィルタ設定    .AutoFilter    '検索ワードの要求    UserForm1.Show    'キャンセル時の処理    If MyKey = "False" Or MyKey = "" Then     St1.Rows(HeadLineNum + 1).Delete  'ダミーの見出し行の削除     Exit Sub '終了    End If    '左端の空白列の補正    KeyColumn = KeyColumn - .Cells(1).Column + 1    '変数MyKeyでデータ抽出    .AutoFilter Field:=KeyColumn, Criteria1:=MyKey    '抽出シートの初期化    St2.Cells.Clear    '抽出データ(可視セル)をコピー&ペースト    .SpecialCells(xlCellTypeVisible).Copy _     Destination:=St2.Cells(HeadLineNum, .Cells(1).Column)    'フィルタ解除    .AutoFilter    '見出し行のコピー&ペースト    St1.Rows("1:" & HeadLineNum).Copy _        Destination:=St2.Range("A1")   End With   'ダミーの見出し行の削除   St1.Rows(HeadLineNum + 1).Delete     '最大、最小、平均の計算   With St2    St2LastRow = .UsedRange.Cells(.UsedRange.Cells.Count).Row  '最終行    St2LastCol = .UsedRange.Cells(.UsedRange.Cells.Count).Column '最終列    If St2LastRow - HeadLineNum <= 0 Then Exit Sub    '基準の計算領域    Set St2Rng = _       .Cells(1, CalcStartCol).Resize(St2LastRow - HeadLineNum).Offset(HeadLineNum)    .Range("A" & St2LastRow + 2).Value = "最大"    .Range("A" & St2LastRow + 3).Value = "最小"    .Range("A" & St2LastRow + 4).Value = "平均"    For c = CalcStartCol To St2LastCol     Set St2Rng2 = St2Rng.Offset(, c - CalcStartCol)     If WorksheetFunction.Count(St2Rng2) > 0 Then      .Cells(St2LastRow + 2, c).Value = WorksheetFunction.Max(St2Rng2) '最大      .Cells(St2LastRow + 3, c).Value = WorksheetFunction.Min(St2Rng2) '最小      .Cells(St2LastRow + 4, c).Value = WorksheetFunction.Average(St2Rng2) '平均     End If    Next c    .Activate   End With   '変数の解放   Set St1 = Nothing   Set St2 = Nothing   Set St3 = Nothing   Set St1Rng = Nothing   Set St1Rng2 = Nothing   Set St2Rng = Nothing   Set St2Rng2 = Nothing   Exit Sub Err:  MsgBox "error" End Sub

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.23

ka_ne_deです。 質問の件ですが、 まず、計算領域はコードの下から20行目あたりに For c = CalcStartCol To St2LastCol とありますよね、 ここで、CalcStartCol から St2LastCol まで 繰り返し計算させています。 CalcStartColは、計算(calculation)を開始(Start)する列(Column) という意味で名づけた変数です。 コードの最初の方に、 CalcStartCol = St1.Range("E1").Column '集計開始列の列番号取得 となっていると思いますが、ここで、計算開始列を指定しています。 E列であれば、CalcStartCol = 5とすれば済むのですが、 AE列とかになると、指折り数えるのが大変でしょ。 なので、St1.Range("E1").Column のように 自動で列番号を取得させています。 E1をAE1に変えれば、 VBAが勝手にAE列の列番号、すなわち、31を計算してくれます。 次に、 St2LastCol は、シート2(St2)の最終(Last)の列(Column) という意味で名づけた変数です。 最後のほうに St2LastCol = .UsedRange.Cells(.UsedRange.Cells.Count).Column '最終列 という行があると思います。 ここで、Sheet2で使用している領域の最終列の番号を自動で取得しています。 もちろん、直接 St2LastCol = 10 とか指定してもいいんですが、 これだと、データが横方向に増えたときに、その都度コードを修正 しないといけませんね。それを避けるために自動で計算させています。 <結論> いろいろ書きましたが、結論としては、 現状は 「E列」~「データがある列」まで 計算されます。 これを 例えば、「Z列」からとしたければ、 CalcStartCol = St1.Range("E1").Column '集計開始列の列番号取得       ↓ CalcStartCol = St1.Range("Z1").Column '集計開始列の列番号取得 とするだけです。 余談ですが、 もし、E列以降で計算をしたいが、 H列とK列には文字列が入っているので、 これらの列は除外して計算したい。 といった事もありますよね。 さあ、どうしましょう。 やはり、自動で判定してエラーを出さないように すべきでしょうね。 これは、明日以降の課題にしておきますので、 しばらくお待ちください。

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.22

ka_na_deです。 うまくいったようですね。 良かった良かった。私も素直に嬉しいです。 まだ、気になる箇所がありますが、この辺で一旦終了ですね。 例えば、フィルター領域をUsedRangeを基準に設定してしまった事で、 データのない場所に塗りつぶしなどの書式のみが設定されていると、 そこまで計算対象となるので、Averageの計算でエラーが出るだろう な~ とか。 Sheet2,Sheet3は自動で生成するようにすべきだったかな~  ダミーの見出し行が丸出しだな~とか・・・ あと、ユーザーフォームには、何の入力案内もしていませんので、 ご自分で改良してみてください。 マクロの実行ボタンも自分で名前をつけてください。 気になる所を挙げれば切りが無いので、これで終わります。 お疲れ様でした。 尚、追加で質問や改良の要望があればコメントください。 分かる範囲で回答します。

ainouracho
質問者

補足

ka_na_deさん、こんばんは。 大変良いものを作って頂きありがとうございました。 今日早速職場へ持って行きシートに導入したところ、業務効率化が図れてとても重宝致して、再び感謝感謝でした♪ で、色んなシートにも導入しようかと考えていますが、早速難題にぶつかりまして、お言葉に甘えて再び質問させてください。 作って頂いたtest7の計算領域はE列~V列でしたが、これをV列以降(Z列など)にするには、どこを弄ればいいのでしょうか? 質問ばかりで、すみません。

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.21

最終版として、まとめます。 シート名、マクロ名などは、変更してもらって結構です。 <前提>  元データ:Sheet1のA1~       3行見出し、4行目よりデータ       B列に検索ワードあり       E列~V列まで数値データあり  抽出データ:Sheet2のA1~        抽出データの1行下から、集計計算        A列:最大、最小、平均の見出し        E列以降:計算結果  検索ワード:Sheet3のB2以下に表示されます。 <設定方法> 最初にユーザーフォームを作ります。 1)VBエディターの左上にプロジェクトエクスプローラーが   表示されていると思いますので、VBAProjectの文字の上で   右クリックし、「挿入」→「ユーザーフォーム」としてください 2)「ツールボックス」が表示されますので、その中から、   「コンボボックス」を選択し、ユーザーフォームにドラッグ。   適当に大きさを調整してください。 3)次に、コマンドボタンを選択し、ドラッグ   もう一回、コマンドボタンを選択し、ドラッグ 4)最初のコマンドボタンに名前をつけます。   コマンドボタンの上で右クリックし、プロパティーを選択   左下にずらっと設定項目が並んでいると思いますので、   その中の「Caption」の右側に「OK」と入力 5)2個目のコマンドボタンには、同様に「CANCEL」と名前を   つけてください。 フォーム上も変化しているはずです。   注)2つのコマンドボタンは作成した順に   CommandButton1、CommandButton2というオブジェクト名が   ついていますので、前者のCaptionを「OK」にして下さい。 6)左上のプロジェクトエクスプローラーに   「UserForm1」というモジュールができていますので、   ダブルクリック。そして、右側に 以下のコードを   貼り付けてください。 Private Sub CommandButton1_Click()  'OKボタンが押された場合  MyKey = UserForm1.ComboBox1.Value  Unload Me End Sub Private Sub CommandButton2_Click()  'キャンセルボタンが押された場合  MyKey = "False"  Unload Me End Sub Private Sub UserForm_Initialize()  'ユーザーフォームの初期設定  Dim St3LastRow As Long    With Worksheets("Sheet3")    St3LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row  End With  UserForm1.ComboBox1.Style = fmStyleDropDownCombo  UserForm1.ComboBox1.RowSource = "Sheet3!B2:B" & St3LastRow  UserForm1.ComboBox1.ListIndex = -1 End Sub 次に、以下のメインコードを標準モジュールに貼り付けます。 1)VBエディターの左上にプロジェクトエクスプローラーが   表示されていると思いますので、VBAProjectの文字の上で   右クリックし、「挿入」→「標準モジュール」としてください 2)右の欄に以下のコードを貼り付けます。   注意)MyKeyをパブリック変数としたため、SUBの外に出てます。 Public MyKey As String Sub test7() On Error GoTo Err   Dim St1Rng As Range, St1Rng2 As Range, St2Rng As Range   Dim St1 As Worksheet, St2 As Worksheet, St3 As Worksheet   Dim St1LastRow As Long, St2LastRow As Long, St2LastCol As Long   Dim HeadLineNum As Long, KeyColumn As Long   Dim CalcStartCol As Long   Dim c As Long     Set St1 = Worksheets("Sheet1") '元データのシート   Set St2 = Worksheets("Sheet2") '抽出するシート   Set St3 = Worksheets("Sheet3") '検索ワードリストのシート   HeadLineNum = 3  '見出し行の数 (データ開始行番号-1)   KeyColumn = St1.Range("B1").Column   '検索列の列番号取得   CalcStartCol = St1.Range("E1").Column '集計開始列の列番号取得     'ダミーの見出し行の挿入   St1.Rows(HeadLineNum + 1 & ":" & HeadLineNum + 1).Insert Shift:=xlDown     Set St1Rng = St1.UsedRange   'データ領域+ダミー見出し行   Set St1Rng2 = St1Rng.Resize(St1Rng.Rows.Count - HeadLineNum).Offset(HeadLineNum)     '検索ワードリストの作成   St3.Cells.Clear   With St1    St1LastRow = .Cells(.Rows.Count, KeyColumn).End(xlUp).Row    .Range(.Cells(HeadLineNum + 1, KeyColumn), .Cells(St1LastRow, KeyColumn)).Copy _       Destination:=St3.Range("A1")   End With   With St3    .Range("A1").Value = "リスト"    .Columns("A:A").AdvancedFilter _        Action:=xlFilterCopy, CopyToRange:=.Columns("B:B"), Unique:=True   End With     'オートフィルターによる抽出   With St1Rng2    'フィルタ設定    .AutoFilter    '検索ワードの要求    UserForm1.Show    If MyKey = "False" Then Exit Sub    '左端の空白列の補正    KeyColumn = KeyColumn - .Cells(1).Column + 1    '変数MyKeyでデータ抽出    .AutoFilter Field:=KeyColumn, Criteria1:=MyKey    '抽出シートの初期化    St2.Cells.Clear    '抽出データ(可視セル)をコピー&ペースト    .SpecialCells(xlCellTypeVisible).Copy _     Destination:=St2.Cells(HeadLineNum, .Cells(1).Column)    'フィルタ解除    .AutoFilter    '見出し行のコピー&ペースト    St1.Rows("1:" & HeadLineNum).Copy _        Destination:=St2.Range("A1")   End With   'ダミーの見出し行の削除   St1.Rows(HeadLineNum + 1).Delete     '最大、最小、平均の計算   With St2    St2LastRow = .UsedRange.Cells(.UsedRange.Cells.Count).Row  '最終行    St2LastCol = .UsedRange.Cells(.UsedRange.Cells.Count).Column '最終列    If St2LastRow - HeadLineNum <= 0 Then Exit Sub    '基準の計算領域    Set St2Rng = _       .Cells(1, CalcStartCol).Resize(St2LastRow - HeadLineNum).Offset(HeadLineNum)    .Range("A" & St2LastRow + 2).Value = "最大"    .Range("A" & St2LastRow + 3).Value = "最小"    .Range("A" & St2LastRow + 4).Value = "平均"    For c = CalcStartCol To St2LastCol     .Cells(St2LastRow + 2, c).Value = _          WorksheetFunction.Max(St2Rng.Offset(, c - CalcStartCol)) '最大     .Cells(St2LastRow + 3, c).Value = _          WorksheetFunction.Min(St2Rng.Offset(, c - CalcStartCol)) '最小     .Cells(St2LastRow + 4, c).Value = _          WorksheetFunction.Average(St2Rng.Offset(, c - CalcStartCol)) '平均    Next c    .Activate   End With   '変数の解放   Set St1 = Nothing   Set St2 = Nothing   Set St3 = Nothing   Set St1Rng = Nothing   Set St1Rng2 = Nothing   Set St2Rng = Nothing   Exit Sub Err:  MsgBox "error" End Sub 最後におまけですが、このtest7の実行は、 シート上にコマンドボタンを貼り付けて、 それがクリックされたら実行するようにすると さらに便利です。 例えば、Sheet1を選択し、 上部メニューで 「表示」→「ツールバー」→「コントロールツールボックス」 として、「コントロールツールボックス」を表示させます。 「コマンドボタン」を押して選択し シート上で、ドラッグしてボタンを配置 ボタンをダブルクリック (もし、ダブルクリックできないなら、  デザインモードになっていないので  「コントロールツールボックス」の三角定規アイコン  を押してデザインモードにしてください。) Private Sub CommandButton1_Click() End Sub とでてくるので、 Call test7 を中にコピーしてください。 そして、Sheet1に戻り、三角定規ボタンを押して、 デザインモードを終了。 その後、ボタンを押せばマクロが実行されます。 以上です。

ainouracho
質問者

お礼

できました。 本当に深く深く感謝・感激しています。 ありがとうございました。 自分もこれから勉強し作っていただいたのを基本にして、所々変更していきたいと思います。 あと、他のファイルにも使えそうなので、移植したいと考えています。 本当にありがとうございました。

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.20

まず、シートにボタンを貼り付けていますか? 上部メニューで 「表示」→「ツールバー」→「コントロールツールボックス」 として、 「コントロールツールボックス」を表示させます。 「コマンドボタン」を押して選択し シート上で、ドラッグしてボタンを配置 ボタンをダブルクリック (もし、ダブルクリックできないなら、  デザインモードになっていないので  「コントロールツールボックス」の三角定規アイコン  を押してデザインモードにしてください。) Private Sub CommandButton1_Click() End Sub とでてくるので、 Call test6 を中にコピーしてください。 そして、三角定規ボタンを押して、 デザインモードを終了。 その後、ボタンを押せばマクロが実行されます。 それから、現在、コンボボックスに表示されるリストは B2:B100 となっています。 本来はリストの数だけ表示するべきなので後に変更します。 エラーがすべて無くなり思いどおりの動きをするように なったら教えて下さい。

ainouracho
質問者

補足

一応、ボタンも配置し動作も良好になったと思います。 その後の、抽出から平均算出までエラーも出ずなりました。 ありがとうございます。

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.19

ka_na_deです。 私はずっとシート2から実行していたので、 この問題に気づきませんでした。 先ほどの箇所を 以下に変更してください。    Next c    .Activate   End With それから、ボタンを押してマクロ実行はできてますか?

ainouracho
質問者

補足

>>ボタンを押してマクロ実行はできてますか? 先ほどから、やっているのですがtest6が実行されません。 コードは先ほど書かれていたコードのみでいいのですか? Private Sub CommandButton1_Click() Call test6 End Sub

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.18

エラー再現できました。 ちょっと待っててください。

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.17

もう少しですね。 意味不明なエラーですね。 試しに、 ' .Range("A1").Select のように、先頭に '  を入れてコメント化してください(緑色になります) これでエラーになる場合は、どこが黄色になりますか? くどいようですが、 Sheet1に空白行が残っていたら削除しておいて下さい。

関連するQ&A

  • エクセルで列Aの同じ値のものを15行ずつ表示したい

    「エクセルで同じ列の値のものを15行ずつ表示したい」というタイトルではきちんと表現できませんでしたが、 以下のことはできますでしょうか?    A   B   C 1 りんご  1   100  ・・・ 2 りんご  9   100  ・・・ 3 みかん  4   70  ・・・ 4 なし   3   110  ・・・ 5 なし   1   110  ・・・ 6 なし   5   110  ・・・ といったシートがあるとします。 これを「A」の列を基準に15列ずつに分けたいと思います。    A   B   C 1 りんご  1   100  ・・・ 2 りんご  9   100  ・・・ ・・・15まで空白 16 みかん  4   70  ・・・ ・・・30まで空白 31 なし   3   110  ・・・ 32 なし   1   110  ・・・ 33 なし   5   110  ・・・ ・・・45まで空白 何かよい方法があれば教えてください。 よろしくお願いいたします。

  • 列と行で一致したセルに

    HY-123 1/3 15個 AB-456 1/1 50個  といようなデータを入力したら 自動で下の表(A列の製造番号、1行目の日にちは固定の表)に 個数が入るにはどうすればいいですか? 番号と日付が一致すれば、その交差セルに個数が出るようにしたいのです。 宜しくお願いいたします。 1月  A     B    C    D 1          1    2    3 2  HY-123            15 3  AB-456   50

  • 関数について教えて下さい。A列の1行目に1、3行目に5、6行目に8、1

    関数について教えて下さい。A列の1行目に1、3行目に5、6行目に8、10行目に11と規則的でない行に規則的でない番号が入力されているデータがあり、このA列の番号を、シート2のA列の2行目から下に順番に表示したいのですが、そのような関数などあるでしょうか?。どなたかよろしくお願いします。 A列1行目 1   2行目   3行目 5   4行目   6行目 8   ・   ・   ・ 別シートA列 2行目 1          3行目 5        4行目 8         ・         ・         ・

  • Excelで、A列、B列の値を新しいシートに3行ごとにどんどん貼り付け

    Excelで、A列、B列の値を新しいシートに3行ごとにどんどん貼り付ける。 という事をしたいのですが、VBAを始めたばかりなので上手く書くことが出来ません。 例)    A列   B列   101  りんご    102  ぶどう   103  オレンジ   104   桃   105  バナナ      ・      ・      ・ これを別のシートに    A列   B列   101  りんご (2行あける)   102  ぶどう (2行あける)   103  オレンジ (2行あける)    104   桃 (2行あける)    105  バナナ      ・      ・      ・ と表示したいのです。 現在は下記のようなリンクで表示していますが、 件数が少ない時は4件から多い時は800件と幅があります。 出来れば表の一番下(空欄になる部分)まで繰り返し処理をしたいと思っています。 セルの中身が表示されるならリンクでもコピーでも構いません。 現在のマクロ Sub Macro2() Worksheets("Sheet2").Select Range("C11").Value="=Sheet1!A2" Range("C14").Value="=Sheet1!A3" Range("C17").Value="=Sheet1!A4" Range("C20").Value="=Sheet1!A5" Range("C23").Value="=Sheet1!A6" Range("H11").Value="=Sheet1!B!" Range("H14").Value="=Sheet1!B2" Range("H17").Value="=Sheet1!B3" Range("H20").Value="=Sheet1!B4" Range("H23").Value="=Sheet1!B5" End sub 45行分まで書いたところで途方に暮れております。 よろしくお願いいたします。

  • 行と列の条件に一致したら印を付けたい

    シート1に名前と商品のリストがあります 名前 商品 佐藤 りんご 佐藤 みかん 佐藤 ぶどう 加藤 みかん 山本 バナナ 山本 みかん 小林 りんご 小林 ぶどう 小林 みかん 小林 バナナ シート2の行に名前、列に商品名の表があり、シート1のリストを元に 行と列の条件に一致した箇所に印をつけたいのですが、 何か適当な関数はありますでしょうか? りんご みかん ぶどう バナナ 佐藤 加藤 山本 小林

  • 【Excel】行と列で値を検索したい

    こんにちは Sheet1に表があります。 Sheet2のA列と1行に値を入力したときに、 Sheet1の交わる値を表示したいのですが、 Sheet2のB2、C2、B3、C3の式を教えて下さい。 Excel2013です。 宜しくお願いいたします。

  • エクセルでB列に#N/Aが入った行を非表示にしたい

    添付表のように2枚のシートからの検索結果一覧表を作成したのですが、検索対象によっては各シートで100件程度の場合があり、B列が#N/Aの行を非表示にしたいのですが。 また、Book保存時には非表示を解除するところまでコード化していただけるとありがたいです。 次回検索した人がピンクの列の一部が非表示になっていることに気付かない可能性がありますので。

  • エクセル AVERAGEを取るときに

    平均値を取りたいのですが 範囲が少し複雑だったのでどのように式を作ったらいいのか わかりません。 シート1に A列 りんご みかん ばなな このようにデータがありそれぞれシート2にある りんご の個数の平均値をB列に求めたいのですが シート2には A列   B列 りんご  3      8      9 みかん  5      9      10 このように果物の種類の項目名が1番上にしかなく 個数はそれに対して必ず3行あるので VLOOKUPなどを使うとりんごと書かれている真横のセルしか 参照しないので常にその項目の横のセルから3行を参照したい のですが どうしたらよいでしょうか? 教えてください。よろしくお願いいたします。

  • 検索2列で一致した個数を表す関数

    エクセル2000にある表1を元に表2を作成しようとしています。 表1 A列:「都道府県」 B列:「市区町村」 C列:「フラグ」 表2 D列:「都道府県」 E列:「件数」 F列:「フラグ数」 表1は既に値が入っていて、ある条件を見たすとC列(フラグ)に"○"がつきます。レコード自体が増える可能性はありますが、増える場合は一番下の列に追加される形で増えます。 表2はD列は既に値(都道府県名)が入っていて変わることはありません。E列とF列を関数で制御したいと思っています。(マクロは使用不可) E列は表2のE列に一致するA列の個数 F列はEの個数の中でC列のフラグが"○"の個数です。 E列は「COUNTIF」で書けましたが、 F列の関数が分かりません。 分かる人がいましたら、教えて下さい。 よろしくお願いします。 <表1>   A列   B列    C列   都道府県 市区町村  フラグ   --------------------------- 1 東京都   新宿区 ○ 2 東京都   豊島区 3 東京都   渋谷区 4 神奈川県  横浜市  ○ 5 神奈川県  厚木市  ○ <表2>   D列   E列    F列   都道府県 件数   フラグ数   ----------------------------- 1 東京都  3     1 2 神奈川県 2     2

  • エクセルで同一行複数列の値が一致する別表の行検索

    エクセルのBOOK内にある2つのシートにあるそれぞれの表を、「表あ」と「表い」とします。「表あ」のA列とC列とF列には、それぞれ「車種名」「色」「値段」が書かれている表だとし、「表い」にはB列とD列とG列にそれぞれ、「車種名」「色」「値段」が書かれているとします。ここで「表あ」の5行目のA列とC列とF列に例えば「スカイライン」「黒」「100万円」とかかれていたとすると、これと同じ「車種名」「色」「値段」の行が、「表い」のどの行にあるか、その行番号を「表あ」5行目のH列に表す計算式を5Hのセルに入れる方法をご存じでしたら、教えて頂けないでしょうか。1行完成したら、以下同様にコピーで広げていきたいと考えております。

専門家に質問してみよう