• ベストアンサー
  • すぐに回答を!

エクセル 別シートから値を検索して挿入 VBA

いつもお世話になっております。 VBAにて、Sheet1 の【原価】に【商品】をキーにしてSheet2の【原価】を検索して挿入するコードを作成しました。 元々Shee1の【原価】にはすでに数値が入っていますが、下記のコードを実行すると上書きする処理のため、検索にヒットしない商品の【原価】はエラー【#N/A】となります。 ※画像参照願います。 目的はヒットする商品名の【原価】のみが更新される、 ヒットしない場合エラー【#N/A】を出さないようにする。 改良をご教示頂ければ助かります。 Sub データ検索() Application.ScreenUpdating = False Dim I As Long   I = 2 Do While Range("A" & I).Value <> ""  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = _   Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, Worksheets ("Sheet2").Range("A2:B65535"), 2, 0)  I = I + 1 Loop Application.ScreenUpdating = True End Sub

共感・応援の気持ちを伝えよう!

  • 回答数5
  • 閲覧数475
  • ありがとう数2

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

  • ベストアンサー
  • 回答No.5

sheet1に既に単価が入力されてるなら空白を入力しないようにするだけでしょう。その修正も出来ませんか? Sub データ検索() Dim I As Long Dim ws As Worksheet Application.ScreenUpdating = False Set ws = Sheets("sheet2") With Sheets("sheet1") I = 2 Do While .Range("A" & I).Value <> "" If Application.CountIf(ws.Range("A:A"), .Range("B" & I)) = 1 Then .Range("C" & I).Value = _ Application.VLookup(.Range("B" & I).Value, ws.Range("A:B"), 2, 0) End If I = I + 1 Loop End With Application.ScreenUpdating = True End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

dogs_cats さん、ありがとうございます。コード内容が一番シンプルで解読しやすいため、ベストアンサーとさせて頂きました。おっしゃる通り勉強致します。ほかの方もご回答ありがとうございました。

関連するQ&A

  • VBAのエラーについて

    いつも識者の皆様にはお世話になっております。 Excel VBAのことで質問させてください。 Range("i23").Value = Application.VLookup(ThisWorkbook.Worksheets("aaa").Range("b5"), ThisWorkbook.Worksheets("data").Range("a2:b7"), 2, 0) というコードは通るのですが、 Range("i23").Value = Application.Left(VLookup(ThisWorkbook.Worksheets("aaa").Range("b5"), ThisWorkbook.Worksheets("data").Range("a2:b7"), 2, 0), 2) というleft関数を追加したコードだと「sub または function が定義されていません」というエラーになってしまいます。 VBAを始めたばかりなのですが、何か根本的な勘違いをしていますでしょうか? ちなみに Range("i23").Value = Application.Left(Application.VLookup(ThisWorkbook.Worksheets("aaa").Range("b5"), ThisWorkbook.Worksheets("data").Range("a2:b7"), 2, 0), 2) というコードも通りませんでした。 ご回答よろしくお願いいたします。

  • ExcelVBAにて異なるシート間での値貼り付け

    Excel VBAの異なるシート間での値のコピーと貼り付けに関して質問をさせてください。 私はExcel2007を使って、Sheet1のセルの値をsheet2に貼り付けようとして以下のコード(1)を書きましたが、うまくいきません。動作確認のためsheet1内での値のコピペを行うコード(2)を作成し実行したところ、正常に動作しました。 コード(1)をコンパイルしたときに表示されるメッセージは、[実行時エラー'1004':アプリケーション定義またはオブジェクト定義のエラーです] です。 質問としては、 Q1:等号(=)を用いた値の貼り付けは、異なるシート間に対応していないのでしょうか。 Q2:コード(1)を改良する場合、どのように書き直せばよいでしょうか。 アドバイスいただけましたら幸いです。 コード(1) Worksheets("Sheet2").Range(Cells(1, 10), Cells(5, 10)).Value = Worksheets("Sheet1").Range(Cells(1, 1), Cells(5, 1)).Value コード(2) Worksheets("Sheet1").Range(Cells(1, 10), Cells(5, 10)).Value = Worksheets("Sheet1").Range(Cells(1, 1), Cells(5, 1)).Value

  • InputBoxの値で検索して転記するマクロ

    1.InputBoxを3回表示させます。 2.ユーザーに入力してもらいます。 入力できるのは半角英数字のみでそれ以外は エラーメッセージを出したいです。 3.1回目は18桁か22桁以外の場合、 2回目と3回目は4桁以外の場合はMsgBoxを表示して 再入力を促します。 4.InputBoxに入力された値の3個を連結した値で Sheet2のA列を検索して 合致したらその行のG列の値を見ます。 5.G列に"済"とあったら MsgBoxを表示して 中止するか継続するか判断します。 6.継続した場合 その該当行の各列の値をSheet1にそれぞれ転記します。 Sheet2の該当行のB列→Sheet1のセルB3 Sheet2の該当行のC列→Sheet1のセルC3 Sheet2の該当行のD列→Sheet1のセルD3 Sheet2の該当行のE列→Sheet1のセルE3 Sheet2の該当行のF列→Sheet1のセルF3 7.かつSheet2の該当行のG列に 済 と転記します。 すでに済が記入されている場合は上書です。 以下のように作成しましたがエラーで動かなくて動作確認が出来ません。 どう直せばいいのか教えてください。 イレギュラー時の対応処理が必要だとも思うのですが動作しない為 思いつきません。 記述が滅茶苦茶なのですがこれが限界です。申し訳ありません。 Sub 表示板作成() Dim 検索値1 Dim 検索値2 Dim 検索値3 Dim 検索値4 Dim 判定値 Dim 判断 Dim 記録 Dim 確認 検索値4 = 検索値1&検索値2&検索値3 Do 検索値1 = Application.InputBox("型番を入力してください") If Len(検索値) < 18 Then MsgBox "18桁未満です。再入力しますか?" Loop Else Exit Do '検索値2と3も上記と同じ記述をここへ入れる '(現在省略) End If 判定値 = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 7, 0) If 判定値 = "済" Then 判断 = MsgBox("発行済みです。再度データ取得しますか?", vbYesNo) Else Select Case 判断 Case vbNo Exit Sub Case vbYes Range("B3").Value = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 2, 0) Range("B4").Value = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 3, 0) Range("B5").Value = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 4, 0) Range("B6").Value = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 5, 0) Range("B7").Value = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 6, 0) End Select End If 記録 = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 7, 0) 記録.Value = "済" 確認 = MsgBox("これは●●用です。いいですか?", vbYesNo) Select Case 確認 Case vbNo Exit Sub Case vbYes Call 印刷 End Select End Sub

その他の回答 (4)

  • 回答No.4

 こういう方法もあります。 Sub Macro1() Const mySheetName1 = "Sheet1" Const FirstRow1 = 2 Const CommodityColumn1 = 2 Const CostColumn1 = 3 Const mySheetName2 = "Sheet2" Const FirstRow2 = 3 Const CommodityColumn2 = 1 Const CostColumn2 = 2 Dim mySheetName(1) As String, mySheet(1) As Worksheet _ , LastRow As Long, i As Long, c As Range mySheetName(0) = "Sheet1" mySheetName(1) = "Sheet2" For i = 0 To 1 Set mySheet(i) = Sheets(mySheetName(i)) Next i With mySheet(0) LastRow = .Cells(Rows.Count, CostColumn1).End(xlUp).Row If LastRow < FirstRow1 Then Exit Sub Application.ScreenUpdating = False Application.Calculation = xlManual With Range(.Cells(FirstRow1, CostColumn1), .Cells(LastRow, CostColumn1)) For Each c In .Offset(0) c.FormulaR1C1 = "=IF(RC" & CommodityColumn1 & "="""","""",IF(COUNTIF(" _ & mySheetName(1) & "!C" & CommodityColumn2 & ",RC" & CommodityColumn1 _ & "),VLOOKUP(RC" & CommodityColumn1 & "," & mySheetName(1) & "!C" _ & CommodityColumn2 & ":C" & CostColumn2 _ & "," & CostColumn2 - CommodityColumn2 + 1 & ",FALSE)," & c.Value & "))" Next c .Parent.Calculate .Value = .Value End With End With With Application .Calculation = xlAutomatic .ScreenUpdating = True End With End Sub

共感・感謝の気持ちを伝えよう!

質問者からの補足

kagakusuki さん、ご回答ありがとうございます。正直今のレベルでは内容が理解できません。ゆっくりですが勉強して解読したいと思います。 ありがとうございました。

  • 回答No.3
  • keithin
  • ベストアンサー率66% (5278/7939)

ん? >関数式は残したくありません。 >数値として残す場合はどのような処置となりますでしょうか? 回答したマクロの最後の方の3カ所の「’」を消します。 #コピーして動かしてみたー できたー ダメだったー でオワリじゃなくて,回答のマクロがナニをやってるのかご自分なりにちょっと考えてみると良いと思います。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

keithin さん、早速にありがとうございます。おっしゃる通り勉強不足です。勉強致します。ありがとうございました!

  • 回答No.2
  • keithin
  • ベストアンサー率66% (5278/7939)

アイデア次第でやりようはいくらでもあります。 作成例:セルをイチイチ巡回するのもやめ。該当データ行だけ限定で一気にVLOOKUPする sub macro1()  worksheets("Sheet1").range("B:B").advancedfilter _   action:=xlfilterinplace, _   criteriarange:=worksheets("Sheet2").range("A1:A" & worksheets("Sheet2").range("A65536").end(xlup).row), _   unique:=false  worksheets("Sheet1").range("C2:C" & worksheets("Sheet1").range("B65536").end(xlup).row).specialcells(xlcelltypevisible).formular1c1 _  = "=VLOOKUP(RC[-1],Sheet2!C1:C2,2,FALSE)"  worksheets("Sheet1").showalldata ’with worksheets("Sheet1").range("C2:C" & worksheets("Sheet1").range("B65536").end(xlup).row) ’ .value = .value ’end with end sub

共感・感謝の気持ちを伝えよう!

質問者からの補足

keithin さん、早速にご回答ありがとうございます。 おおむね、ご回答頂きました処置で目的は達成しておりますが 関数式は残したくありません。 数値として残す場合はどのような処置となりますでしょうか? お手数ですがよろしくお願い致します。

  • 回答No.1

countif関数で商品名の有無を検索すれば良いのでは。 本コードでは他のBOOKをオープンさせていないのでthisworkbookは不要と判断しました。 商品名が存在しない場合は空白を単価に入力する事にしています。 Sub データ検索() Dim I As Long Dim ws As Worksheet Application.ScreenUpdating = False Set ws = Sheets("sheet2") With Sheets("sheet1") I = 2 Do While .Range("A" & I).Value <> "" If Application.CountIf(ws.Range("A:A"), .Range("B" & I)) = 1 Then .Range("C" & I).Value = _ Application.VLookup(.Range("B" & I).Value, ws.Range("A:B"), 2, 0) Else .Range("C" & I).Value = "" End If I = I + 1 Loop End With Application.ScreenUpdating = True End Sub sheet2をwsというオブジェクト変数に格納して、コードを短くしています。 http://officetanaka.net/excel/vba/variable/04.htm withステートメントでsheet1を指定しています。 sheet1に関するrangeの前にピリオドを付ける必要があります。 withステートメントの説明 http://officetanaka.net/excel/vba/beginner/16.htm

共感・感謝の気持ちを伝えよう!

質問者からの補足

dogs_cats さん、早速にご回答・参考ありがとうございます。 ↓↓ 商品名が存在しない場合は空白を単価に入力する事にしています。 ご説明不足で申し訳ございません。 元々Sheet1の商品にすべて原価が入っており、 VBAを実行すると該当の商品名だけが更新され、空白およびエラー【#N/A】にならないように処理し、 かつ、該当しない商品名の原価はそのままの数値を残したいと考えております。お手数ですがその場合はどのような処理となりますでしょうか?

関連するQ&A

  • VBAについて

    VBAについて質問です。 データをコピーして新規ブックとして名前(年、月、日)をつけて別のフォルダ(デスクトップ上のフォルダ)に毎朝8時に保存したいのですが、Cディスク内に直接保存されてしまいます。 コードは以下の通りです。 Sub 自動保存() With workbooks("サンプル.xism") Worksheets("Sheet3").Range("B6:B205").Value = .Worksheets("メインモニタ").Range("F13:F212").Value Worksheets("Sheet3").Range("D6:D205").Value = .Worksheets("メインモニタ").Range("K13:K212").Value Worksheets("Sheet3").Range("F6:F205").Value = .Worksheets("メインモニタ").Range("P13:P212").Value Worksheets("Sheet3").Range("H6:H205").Value = .Worksheets("メインモニタ").Range("U13:U212").Value End With Worksheets("Sheet3").Select Worksheets("Sheet3").Copy Application.DisplayAlerts = False With ActiveWorkbook.SaveAs "C:\サンプル2_" & Format(Date , "yyyymmdd") . Close End With Application.DisplayAlerts = True Application.OnTime DateValue(Date + 1) + TimeValue("8:00:00") , "自動保存" Worksheets("メインモニタ") . Activate End Sub ご教授宜しくお願いします。

  • Setステートメントをまとめて記述する方法 (エクセル2000VBA)

    お世話になります。 Setステートメントで以下のように書いて、シート名を省略して使っています。  Set a = ThisWorkbook.Worksheets("い")  Set b = ThisWorkbook.Worksheets("ろ")  Set c = ThisWorkbook.Worksheets("は") これをプロシージャ毎に書くとコードが長くなるので、先頭かどこかに1回書くだけで、全てのプロシージャで使えるようにしたいのですがどうしたら良いでしょうか? このようなプロシージャを実行したいのですが、 Private Sub CommandButton1_Click()  a.Range("A2").Value = "データ1"  b.Range("B4").Value = "データ2"  c.Range("C9").Value = "データ3" End Sub (他にもコマンドボタンやチェックボックス用のプロシージャがあります) Setステートメントだけを先頭に書くと、 「プロシージャの外では無効です」というエラーが出ましたので、 Public Sub hensuu()  Set a = ThisWorkbook.Worksheets("い")  Set b = ThisWorkbook.Worksheets("ろ")  Set c = ThisWorkbook.Worksheets("は") End Sub のようにしたら、「実行時エラー"424":オブジェクトが必要です」というエラーが出てしまいました。 どのようにしたらエラーが出ず正しく動くようになりますでしょうか?よろしくお願いします。

  • 【VBA】シートのコピー &#65374; 値に直す

    大変お世話になります。 VBAのコードについてご教示いただけませんでしょうか。 ■やりたいこと -------------------------------------------------------------------------------- (1) 【原紙】Sheetを、同ブック内の新規シートへコピー (2) 新規シートのシート名を、[セル:B5]の値に変更 (3) 新規シートにコピーされてきた数式を値に変更 ■作成してみたコード -------------------------------------------------------------------------------- Sub SheetCopy1() Worksheets("【原紙】Sheet").Copy Before:=Worksheets("【原紙】Sheet") ActiveSheet.Name = Range("B5").Value Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub -------------------------------------------------------------------------------- 本日初めてVBAに触れた者が、見よう見まねで『■やりたいこと』を並べたコードのため、やはりエラーになってしまいます。 上記は、どこをどう直せばよろしいでしょうか。 もしくは、そもそも間違っておりますでしょうか。 ご教示いただきたく、何卒よろしくお願いいたします。 ◎もし可能でしたら、併せてご教示ください◎ ---------------------------------------------------------------------------- (1)の動作をさせるために、【原紙】Sheetの任意の場所に”ボタン”を設置するのですが、新規シートにもコピーされるため、そのコピー側のボタンを削除できたら…とも考えていますが、そういう動作も可能でしょうか。

  • Excel VBAグラフチャート名で指定するには再

    以前に質問しましたが解決していませんので再度質問します。 ActiveChartではなく、具体的なチャート名で 指定するにはどのように記述すればよいでしょうか。 具体的には、以下のtest()のコードの最後の1行 ActiveChart.SetSourceData Source:=Range("Sheet1!A1:B2"), PlotBy:=xlRows をActiveChartを使わずに記述するには、 どのように記述すればよいでしょうか。 回答例のように具体的なコードを教えてください。 よろしくお願いします。(Windows10,Excel2016) --------------------------------------- Sub test()  ThisWorkbook.Worksheets("Sheet1").Select  ThisWorkbook.Worksheets("Sheet1").Range("A10").Select  ThisWorkbook.Worksheets("Sheet1").Shapes.AddChart2(297, xlBarStacked100).Select  ActiveChart.SetSourceData Source:=Range("Sheet1!A1:B2"), PlotBy:=xlRows End Sub --------------------------------------- (注1)test()を実行する前にSheet1シートのセルA1,A2,B1,B2にA,B,75,25の値を入力してから実行してください。 (回答例) --------------------------------------- Sub test()  Dim chart_name As String  ThisWorkbook.Worksheets("Sheet1").Select  ThisWorkbook.Worksheets("Sheet1").Range("A10").Select  ThisWorkbook.Worksheets("Sheet1").Shapes.AddChart2(297, xlBarStacked100).Select  chart_name = ActiveChart.Name  chart_name = Trim(Right(chart_name, Len(chart_name) - Len(ActiveSheet.Name)))  ThisWorkbook.Worksheets("Sheet1").ChartObjects(chart_name).SetSourceData Source:=Range("Sheet1!A1:B2"), PlotBy:=xlRows End Sub --------------------------------------- (注2)ただし、このコードではエラーになります。 (注3)回答例のようにチャート名を取得するためにActiveChartを使用するのは可です。

  • 「オブジェクトが必要です。」エラーになります。

    次のコードで2.は動くのですが、1.が動きません。「オブジェクトが必要です。」エラーになります。 何が違うんでしょうか? 教えてください。よろしくお願いします。 Function hoge(aa As Range) aa.Value = "Hello!!" End Function Sub Worksheet_Activate() Dim a As Range Set a = ThisWorkbook.Worksheets("Sheet1").Range("G10") hoge (a) ' ←1.これだとエラーになる ' hoge (ThisWorkbook.Worksheets("Sheet1").Range("G10")) ' 2.こちらはOK End Sub

  • 【VBA】 超初心者です 複数のシートに転記したい

    Sub べんきょう() Worksheets(Array(1, 3)).Select Range("A1").value = 20 End Sub もしくは Sub べんきょう() Worksheets("sheet1").Select Worksheets("sheet3").Select False Range("A1").value = 20 End Sub でやってもsheet1にしか転記されないんです!! ご指導よろしくお願いします!

  • エクセルVBA 1つのシートで出来ますか?

    説明が下手で申し訳ございませんが、宜しくお願い致します。 sheet(1)に20個のボタンがあります。 ボタンをクリックすると、別のシートが開きます。 開いたシートにも複数のボタンがあり、そのうちの任意のボタンをクリックすると、そのボタンの値がsheet(1)のそれぞれのボタンに対応したセルに入力される、という動作を実現したいと思っています。 現状、下記のようなコードで目的の動作は実現できてはいるのですが、各ボタンそれぞれにシートを作っているような状況です。(データ自体は全く同じ内容のものが、計20シート) たぶん、もの凄く頭の悪い事をやっているんだろうと思います。 sheet(1)を除いた各シートの入力データ自体は全く同じなので、シート一枚で出来るんじゃないのかなと思い、ネットや本で調べながら色々試してみたのですが、どうも上手く行きません。データが同じでも、sheet(1)のクリックしたボタンによって入力するセルを変えなければならないのが問題です。 sheet(1)のボタンとセルの関連付けや、sheet(1)のどのボタンを押したのかの判別ができればいいのかなと思って調べてみても、初心者にはよく理解できず、もう何週間もチャレンジしているのですがお手上げです。 上級者の方の知恵をお借りできれば幸いです。 Sub sheet2を開く() Worksheets(2).Select End Sub Sub 入力1() Worksheets(1).Range("F8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("F8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("F8") = "データ3" Worksheets(1).Select End Sub Sub sheet3を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("H8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("H8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("H8") = "データ3" Worksheets(1).Select End Sub Sub sheet4を開く() Worksheets(3).Select End Sub Sub 入力1() Worksheets(1).Range("M8") = "データ1" Worksheets(1).Select End Sub Sub 入力2() Worksheets(1).Range("M8") = "データ2" Worksheets(1).Select End Sub Sub 入力3() Worksheets(1).Range("M8") = "データ3" Worksheets(1).Select End Sub    ・    ・    ・    ・    ・

  • エクセルVBA の変数を使うべきでしょうか?

    はじめまして。エクセル初心者です。 書籍やサイトで勉強させてもらっていますが、VBAがなかなか難しくてすぐに壁にぶつかってしまいます。少々困ってしまい、詳しい方のアドバイスを頂ければと質問を投稿させていただきました。 どうか宜しくお願い致します。質問ですが、 以下のようなコードで、sheet5のB列の任意のセルをダブルクリックした場合、sheet5のBCD列の同じ行のセル値がsheet1の指定した列に入力されるという処理を作りました。 これで一応目的の動作はするのですが、数が増えると「コンパイルエラー・プロシージャが大きすぎます」というメッセージがでてしまいます。列や行には規則性があるので、もしかしたら変数というものを使ってコードを書き直せばいいのかなと思いネットで調べてみたのですが、今のところさっぱり理解できません。 申し訳ありませんが、分かりやすくご教授いただけないでしょうか。バージョンは2003を使っています。 また、下のコードですと、sheet5のBCDいずれかのセルに空白があった場合、sheet1の列に入力されるときに入力される行がずれてしまいます。今は空白を何かで埋めて対処しているのですが、この問題の解決策も教えて頂けると助かります。どうか宜しくお願い致します。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Target.Address = "$B$2" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B2") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C2") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D2") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$3" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B3") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C3") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D3") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$4" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B4") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C4") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D4") Worksheets("sheet1").Activate cancel = True End If   ・     ・   ・     ・   ・     ・ End Sub

  • ブック内に特定名のシートがある場合

    はじめまして、こんにちは。 VBAを最近はじめたばかりの者です。質問が初歩的なもので申し訳ないのですが是非教えてください。 以下を使って、複数ブックの○○というシートから指定セルの内容を抜き出したいと思っています。 ところが、ブックによっては○○というシートが存在しない場合があり、その場合には「インデックスが有効でない」というエラーで動作が止まってしまいます。 ブック内に○○というシートがある場合にのみ動作させるようにするにはどのようにすれば良いのでしょうか。 よろしくお願いします。 Dim wb As Workbook, myRow As Long Dim e As Integer myRow = ThisWorkbook.Worksheets(1).Rows.Count With Application.FileSearch .NewSearch .LookIn = ThisWorkbook.Path .SearchSubFolders = True .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then For i = 1 To .FoundFiles.Count If .FoundFiles(i) <> ThisWorkbook.FullName Then Set wb = Workbooks.Open(.FoundFiles(i), UpdateLinks:=0) Application.ScreenUpdating = False ThisWorkbook.Worksheets(1).Range("A" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F6").Value ThisWorkbook.Worksheets(1).Range("B" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F7").Value ThisWorkbook.Worksheets(1).Range("C" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F8").Value ThisWorkbook.Worksheets(1).Range("D" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("Y6").Value wb.Close False End If Next i Else MsgBox "ファイルがありません。" End If End With End Sub

  • エクセルのフォームのVBAについて

    VBAがまったくわからないのに参考書を見て高度な事に挑戦しています フォームは作れてフォームをクリックやら入力やらして作ったOKボタンを押すと シート2のA1B1C1‥の列に入力文字だけが羅列されます。 しかし次にやろうとするとA2B2C2‥と下に行かず又A1B1C1‥の列の文字が変更になり続きません。何がいけないのでしょうか? Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row .Range("A" & LastRow).Value = Worksheets("sheet1").Range("A5").Value .Range("B" & LastRow).Value = Worksheets("sheet1").Range("A7").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("A8").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("A10").Value End With End Sub と参考書とおりいれたのですが‥。教えて下さい。