エクセルVBAでグループごとに取り出す方法

このQ&Aのポイント
  • エクセルVBAを使用して、薬品入力のシートに書いてある内容をグループごとに保管場所VBAシートに取り出す方法を教えてください。
  • 具体的には、薬品入力のシートに「亜鉛 E 1」と入力してあった場合、保管場所VBAの該当する箇所に「E」と入力すると、「亜鉛 E 1」という値を取得できるようにしたいです。
  • 以前に質問していただいた内容を参考にして作成しましたが、「オブジェクトが必要です。」というエラーが出てしまいます。どのように修正すれば良いでしょうか。
回答を見る
  • ベストアンサー

エクセルVBAでグループごとに取り出すためには?

「薬品入力」のシートに書いてある内容をグループごとに「保管場所VBA」シートに取り出すためにはどうしたら良いのですか。 たとえば、薬品入力のシートに「亜鉛 E 1」 と入力してあったら、 保管場所VBAのところにEと入力すると 亜鉛 E 1 が出るようにしたいです。 以下は、以前に質問して、お答えいただいた内容を参考にしてつくりました。 しかし、「オブジェクトが必要です。」と出てしまいます。 どうしたら良いのでしょうか。 よろしくお願い致します。 Sub 薬品管理() Dim 保管, 薬品名 As Worksheet Dim 場所入力 As String Dim 縦, 行 As Integer Dim 保管最大, 薬品名最大 As Integer Set 保管 = Worksheets("保管場所VBA") Set 薬品名 = Worksheets("薬品名入力") 場所入力 = 窓.Cells(3, 2).Value '保管場所VBAシート C列の最終行を取得し、最終行が5以上であれば、B6~C列最終行までの値を削除する 保管最大 = 保管.Range("B" & Rows.Count).End(xlUp).Row If 保管最大 > 5 Then 保管.Range("B6:C" & 保管最大).ClearContents '薬品名入力シート B列の最終行を取得 薬品名最大 = 薬品名.Range("B" & Rows.Count).End(xlUp).Row 縦 = 6 For 行 = 3 To 薬品名最大 If 薬品名.Cells(行, 4).Value = 場所入力 Then '薬品名入力ートのB列~DH列の値を保管場所シートのB~G列に出力する 保管.Cells(縦, 2).Resize(, 3) = 薬品名.Cells(行, 2).Resize(, 3).Value 縦 = 縦 + 1 End If Next 保管.Activate End Sub

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

  • ベストアンサー
noname#203218
noname#203218
回答No.1

宣言していないシート名を指定すればエラーになるのは当然ですよね。 誤)場所入力 = 窓.Cells(3, 2).Value 正)場所入力 = 保管.Cells(3, 2).Value エラーとは関係ありませんが If 薬品名.Cells(行, 4).Value = 場所入力 ThenのCells(行, 4)はCells(行, 3)ではありませんか? I

pazu16
質問者

お礼

ありがとうございます。 確かに宣言していないシート名がありました。 また、(行,4)→ (行,3)でした。 ありがとうございました。助かりましたm(_)m

関連するQ&A

  • エクセルVBA VLOOKUPについて

    エクセル VBA初心者です。 関数でのVLOOKUPをVBAで作りたいのですが、上手くいきません。 あらかじめ、Sheet2の1から300行までに A列  / B列 商品名 / 商品コード が入力されています。(名前の定義=商品コード) Sheet1にユーザーフォームを利用して、データを書き込んだ後、 B列に商品名が書き込まれると、 A列に商品コードが表示されるようにしたいと考えています。 A列に =IF(B2="","",VLOOKUP(B2,商品コード,2,FALSE)) と入力していたのですが、 VBAでIfを使って出来ないかと考えてみたのですが、 上手くいきませんでした。 Private Sub Worksheet_Change(ByVal Target As Range) Dim sRow As Long Dim sColumn As Long sRow = ActiveCell.Row sColumn = ActiveCell.Column If Cells(sRow, 2).Value = True Then Cells(sRow, 1).Value = WorksheetFunction.VLookup(Cells(sRow2).Value, Worksheets("Sheet2").Range("A1:B300"), 2, False) ElseIf Cells(sRow, 2).Value = " " Then Cells(sRow, 1).Value = " " End If End Sub ご教授いただけないでしょうか? エクセル2003 WindowsXP

  • エクセル vba セル合計

    添付表について下記の様な処理をしたいのですが途中からVBAの書き方が(セル合計)がわからず困っております。  *日別の原価計(K列のセル値)の小計(K列の最終入力行の下※k112)に計算する。 自分ではこの様を処理を考えております。 (1)商品名(G列)最終入力行の1行下を選ぶ(G112) (2) (1)の同行にある(k112)を合計算出セルとして選ぶ (3)商品名(G列)最終入力行(g112)からその列上の空欄行の1セル下(g66)を見て(要はg 112からEnd(xlUp))、その行と同じ範囲のK列(k112ーk66)を合計をする範囲として選ぶ (4) (2)の合計する範囲を(3)で算出する。 VBA素人の私では(1)~(3)までを下記の通り書きました。 Sub 原価合計求める() Dim lastrowshu As Long Dim lastrowgen As Long Dim fastrowgen As Long lastrowshu = Cells(Rows.Count, 7).End(xlUp).Row + 1 '帳票シートの商品名(G列)最終入力行+1を取得する。 lastrowgen = Cells(Rows.Count, 7).End(xlUp).Row '商品名行の最終入力 fastrowgen = Cells(lastrowgen, 7).End(xlUp).Row '商品名最終入力行から一番上 Cells(lastrowshu, 11).Select ここまでを実行すると添付ファイルでいうk112セルをselectするまではうまくいきましたが、 これ以降の(4)の合計の書き方がわかりません。 どなたか御教授願います。 あるいはもっといい方法があれば同時にご指導頂けますと幸いです。

  • 【エクセル】VBAでハイパーリンクそうさ

    VBAでハイパーリンクのマクロを組んでいます。 A列にホームページ名が50行(シートによってまちまち)くらい並んでいて、 B列に、それに対応するURLが記入されています。B列は空白のところがちらほ らあります。 A列に、A列の表示(ホームぺジ名)のまま、B列のURLでハイパーリンクを張りたい です。リンクは貼れたんですが、ホームページ名がどうやれば表示できるかわかり ません。教えてくださいお願いします。 ダメダメですが、一応自分で書けたところまでを載せておきます。 Sub ハイパーリンク() Dim i As Integer Dim j As Integer j = 50 For i = 1 To j Sheets("Sheet1").Select Cells(i , 1).Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _ Cells(i , 2), TextToDisplay:="" Next i End Sub としました。

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

    エクセルVBAで以下の方法のマクロが分からず、教えて頂きたいです。 まず、ブックAのシートAがあり、シートAのセルD3には号機No.を入力します(999などの数値のみ) 次にブックBのシートBがあり、このシートのD列にも号機No.が入力されています。 やりたい事はブックAのシートAのD3に号機No.を入力したら、ブックBのシートBのD列から同じ号機No.を 探し、当てはまる号機の行のI列、J列、K列、L列、M列をコピーし ブックAのシートAのF13、F14、F15、F16、F17、に貼り付けたいです。 それぞれの貼り付け先は K列⇒F13 L列⇒F14 M列⇒F15 I列⇒F16 J列⇒F17のようになります。 それとブックBのシートBのD列に入力されている号機No.は同じ数値が入力されている時があります。 この場合は必ず下にある号機No.のが最新ですので、そちらを読み取るようにしたいです。 例えば、4行目と8行目に同じ号機No.がある場合は8行目の方を読み取る。 現在は GYOU = Application.InputBox でターゲットの行番号を入力して その行の列をコピー・ペーストしている感じです。 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim tmp() As String If Intersect(Target, Range("D3")) Is Nothing Then Exit Sub Else End If Dim buf As String Dim j As Integer Dim GYOU As String Set xCur = Selection Dim OpenFileName As String Workbooks.Open Filename:="業務都合の為載せれません" GYOU = Application.InputBox("行を選択してください", "行指定") '<キャンセルの場合、処理を終わりにします。> If GYOU = "False" Then Exit Sub For j = 11 To 11 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(13, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 12 To 12 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(14, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 13 To 13 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(15, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 9 To 9 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(16, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 10 To 10 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(17, 6).PasteSpecial Paste:=xlPasteValues Next j ActiveWorkbook.Close SaveChanges:=False With xCur .Parent.Parent.Activate '元のブックへもどる .Parent.Activate '元のシートへもどる End With End Sub ど素人の為、めちゃくちゃな並びだとは思いますが一応現在の状態のマクロを載せておきます。 御指導の程、宜しくお願いします。

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

    エクセルVBAで以下の方法のマクロが分からず、教えて頂きたいです。 まず、ブックAのシートAがあり、シートAのセルD3には号機No.を入力します(999などの数値のみ) 次にブックBのシートBがあり、このシートのD列にも号機No.が入力されています。 やりたい事はブックAのシートAのD3に号機No.を入力したら、ブックBのシートBのD列から同じ号機No.を 探し、当てはまる号機の行のI列、J列、K列、L列、M列をコピーし ブックAのシートAのF13、F14、F15、F16、F17、に貼り付けたいです。 それぞれの貼り付け先は K列⇒F13 L列⇒F14 M列⇒F15 I列⇒F16 J列⇒F17のようになります。 それとブックBのシートBのD列に入力されている号機No.は同じ数値が入力されている時があります。 この場合は必ず下にある号機No.のが最新ですので、そちらを読み取るようにしたいです。 例えば、4行目と8行目に同じ号機No.がある場合は8行目の方を読み取る。 現在は GYOU = Application.InputBox でターゲットの行番号を入力して その行の列をコピー・ペーストしている感じです。 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim tmp() As String If Intersect(Target, Range("D3")) Is Nothing Then Exit Sub Else End If Dim buf As String Dim j As Integer Dim GYOU As String Set xCur = Selection Dim OpenFileName As String Workbooks.Open Filename:="業務都合の為載せれません" GYOU = Application.InputBox("行を選択してください", "行指定") '<キャンセルの場合、処理を終わりにします。> If GYOU = "False" Then Exit Sub For j = 11 To 11 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(13, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 12 To 12 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(14, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 13 To 13 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(15, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 9 To 9 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(16, 6).PasteSpecial Paste:=xlPasteValues Next j For j = 10 To 10 ActiveSheet.Cells(GYOU, j).Copy ThisWorkbook.ActiveSheet.Cells(17, 6).PasteSpecial Paste:=xlPasteValues Next j ActiveWorkbook.Close SaveChanges:=False With xCur .Parent.Parent.Activate '元のブックへもどる .Parent.Activate '元のシートへもどる End With End Sub ど素人の為、めちゃくちゃな並びだとは思いますが一応現在の状態のマクロを載せておきます。 御指導の程、宜しくお願いします。

  • VLOOKUP関数と同じことをVBAでおこなうには

     初めまして、当方VBAの素人です。よろしくお願いします。  同じような質問で、このようなVBAを見つけました。 Sub Macro1() For n = 2 To 5 '処理するSheet2の行数範囲 a = Sheets("Sheet2").Cells(n, 1) 'aにA列の値を代入 For m = 2 To 5 '検索するSheet1の行数範囲 If Sheets("Sheet1").Cells(m, 1) = a Then 'Sheet2のA列の値とSheet1のA列が一致した場合 v = Sheets("Sheet1").Cells(m, 2) 'vにB列の値を代入 Sheets("Sheet2").Cells(n, 2).Value = v 'Sheet2のB列に値を入力 Exit For '値が見つかったのでForを終了 End If Next Next End Sub このVBAではSheet2での検索、入力が列になるのですが、列でなく、行でできないでしょうか。できればSheet1のB列の値をSheet2の1行で検索、Sheet2の2行に入力されるだけではなく、Sheet1のC列の値をSheet3の1行で検索、Sheet3の2行に入力されるようにしたいと思います。  解る方、よろしくお願いします。

  • 条件にあてはまるデータの数をカウントするエクセルVBA

    下記のようにA列に1~3のコードがありB~E列には測定値があります。 B列以降の測定値のカウント(+3の個数、+2の個数…)を列ごとにVBAでカウントしてます。 A列に関係なくカウントするコードは記述して実行できましたが A列の条件が1の時だけカウントするVBAが良くわかりません。 シート A    B    C  ・・・E 1    -1   +1  ・・・ 1    +2   0 2     0   0 3    -3   0 1    -1   +3 101行目以降 +3    カウント数 … +2      〃 +1      〃 0       〃 -1      〃 -2      〃 -3      〃   A列に関係なくカウントするコード sub カウント() Dim 行 As Long Dim 列 As Long For 列 = 2 To 5 For 行 = 101 To 107 Cells(行, 列).Value = Application.WorksheetFunction.CountIf(Range(Cells(2, 列), Cells(100, 列)), Cells(行, 1)) Next 行 Next 列 End Sub

  • VBAについて

    はじめまして、以下のVBAについて質問させてください。 A列にデータの個数だけ連番を振りたくて、以下のVBAを入力しました。 連番を振るシートは複数あり、そのシートによってデータの個数は異なります。 しかし、以下のVBAだと最初のシートの個数に応じて、後のシートの連番も振られてしまいます。データの個数に応じてシートごとに連番を振るには、どうすればよいのでしょうか…?!どうか迷える子羊をお助け下さい(T_T) '一番はじめのシートを選択 Sheet "一番".Select 'A列に連番を振る Dim sh As Variant For sh = 3 To Worksheets.Count Dim number As Integer Dim 行2 As Long number = 1 '2行目~最終行までループ For 行2 = 3 To Cells(Rows.Count, 2).End(xlUp).Row Worksheets(sh).Cells(行2, 1) = number number = number + 1 Next 行2 Next sh

  • エクセル(VBA)で名簿から該当する人を取り出す?

    シート名→ コース別VBA に 表示する窓口を設定しました。 そして、クラス出席番号順 というシート名から そのコース別VBAに表示するという作業です。 表示するのは、番号・名前・住所などです。 一応、下のように打ってみたのですが、 「オブジェクトは、メソッドまたはプロパティをサポートしていません。」 よろしくお願い致します。 Sub コース別表示() Set 窓 = Worksheets("コース別VBA") 引き取り = 窓.Cells(3, 2) Set クラス = Worksheets("クラス出席番号順") 縦 = 6 For 行 = 3 To 351 If クラス.Cells(行, 9) = 引き取り Then 窓.cell(縦, 2) = クラス.Cells(行, 3) 窓.cell(縦, 3) = クラス.Cells(行, 4) 窓.cell(縦, 4) = クラス.Cells(行, 5) 窓.cell(縦, 5) = クラス.Cells(行, 6) 窓.cell(縦, 6) = クラス.Cells(行, 7) 窓.cell(縦, 7) = クラス.Cells(行, 8) 縦 = 縦 + 1 End If Next End Sub

  • エクセルVBAでLOOKUP関数がうまくできません

    エクセルVBAでLOOKUP関数がうまくできません。 入力シートと判別用のシートがあり入力シートで入力した品名を検索値 として判別用シートで数値に置き換えた値をLOOKUPで検索したいのですが WorksheetFunctionクラスのVLOOKUPプロパティを取得できませんと 実行時エラーが出ます。検索しましたが修正方法がわかりません。 構文のどこが原因なのか教えてください。 VBA初心者です。よろしくお願いします。 sub test() Dim データ行 As Long Dim データ数 As Long データ行 = Cells(Rows.Count,8).End(xlUp).Row For データ数 = 11 To データ行 Cells(データ数 ,32) = Application.WorksheetFunction.VLookup(cells(データ数,8),Worksheets("判別シート").Range("B11:E110"),5,False) Next データ数 End sub