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

エクセルのエラートラップについて

エクセルのVBAについて質問です。 以下のように組み込みDATAシートからフィルターをかけて抽出シートへ結果を表示するようになっていますが、DATAシートにデーターがない状態でするとエラーになります. そこで以前エラートラップの方法を教えて頂きました。 オフィス2007では正常に動作します。 試しにオフィス2000で実行するとDATAシートにデーターがあるなしに関わらずDATAシートにデーターがないと処理してしまうのですがエクセル2000では無理なのでしょうか? また回避方法があれば教えて頂きたいのですが、まだまだ勉強中の身ですので教えて頂ければ有難いです。 お手数ですが宜しくお願いします。 Sub 抽出() Application.ScreenUpdating = False Sheets("抽出").Activate Cells.Clear Sheets("抽出").Range("A1").Value = Sheets("DATA").Range("A2").Value Sheets("抽出").Range("B1").Value = Sheets("DATA").Range("B2").Value Sheets("抽出").Range("C1").Value = Sheets("DATA").Range("C2").Value Sheets("抽出").Range("D1").Value = Sheets("DATA").Range("D2").Value On Error GoTo MSG Sheets("DATA").Range("A3").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:D2"), _ CopyToRange:=Sheets("抽出").Range("A1"), _ Unique:=False Sheets("抽出").Columns("A:D").AutoFit Application.ScreenUpdating = True Exit Sub MSG: MsgBox "DATAシートにデーターがない", vbCritical Application.ScreenUpdating = True End Sub

noname#63196

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

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

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

  • ベストアンサー
  • 回答No.2
  • imogasi
  • ベストアンサー率27% (4558/16318)

質問者の路線に乗って答えてよいのか不安アリ(注)ですがVBAでエラー関係のステートメント等は On Error GoTo lime On Error Resume Mext On Error GoTo 0 Err Error 関数では Err Erl Error です WEBで「VBA Erl」など照会してみてください。 ーーー (注)オフィス2007では正常に動作します。 が不思議。 >エクセル2000では無理なのでしょうか? もっと前97などから、On Error GoTo などはあった。

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

関連するQ&A

  • VBAでエラー時にメッセージを表示したい

    こんばんわ! エクセルのVBAについて質問です。 以下のように組み込みDATAシートからフィルターをかけて抽出シートへ結果を表示するようになっていますが、DATAシートにデーターがない状態でするとエラーになりますがその際にDATAシートにデーターが入っていませんとメッセージボックスが出る様にするにはどうすればいいでしょうか? まだまだ勉強中の身ですので教えて頂ければ有難いです。 お手数ですが宜しくお願いします。 Sub 抽出() Application.ScreenUpdating = False Sheets("抽出").Activate Cells.Clear Sheets("抽出").Range("A1").Value = Sheets("DATA").Range("A2").Value Sheets("抽出").Range("B1").Value = Sheets("DATA").Range("B2").Value Sheets("抽出").Range("C1").Value = Sheets("DATA").Range("C2").Value Sheets("抽出").Range("D1").Value = Sheets("DATA").Range("D2").Value Sheets("DATA").Range("A3").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:D2"), _ CopyToRange:=Sheets("抽出").Range("A1"), _ Unique:=False Sheets("抽出").Columns("A:D").AutoFit Application.ScreenUpdating = True End Sub

  • エクセルVBAのフィルター機能について

    こんにちわ! エクセルのVBAを使って複数の条件を入力すると結果シートへ吐き出すプログラムを組み込んでいますが、下から五行目のCriteriaRange:=Sheets("検索").Range("A1:R2"), _の.Range("A1:R2")を変更した際に.Range("A1:R3")にすれば条件を指定できるのですがその状態で条件を一つだけ入力し抽出すると抽出できずすべてのデーターが吐き出されてしまいます。 ただし二行抽出データーを埋めるとそのとおりに抽出され結果シートへ吐き出されます。 抽出する条件を入力する際、一つの時もあれば二つの時もあります。そういった事を回避するにはどうすればいいでしょうか? Sub OutputRec() Application.ScreenUpdating = False Sheets("結果").Activate Cells.Clear Sheets("検索").Range("A1").Value = Sheets("DATA").Range("A1").Value Sheets("検索").Range("B1").Value = Sheets("DATA").Range("B1").Value Sheets("検索").Range("C1").Value = Sheets("DATA").Range("C1").Value Sheets("検索").Range("D1").Value = Sheets("DATA").Range("D1").Value Sheets("検索").Range("E1").Value = Sheets("DATA").Range("E1").Value Sheets("検索").Range("F1").Value = Sheets("DATA").Range("F1").Value Sheets("検索").Range("G1").Value = Sheets("DATA").Range("G1").Value Sheets("検索").Range("H1").Value = Sheets("DATA").Range("H1").Value Sheets("検索").Range("I1").Value = Sheets("DATA").Range("I1").Value Sheets("検索").Range("J1").Value = Sheets("DATA").Range("J1").Value Sheets("検索").Range("K1").Value = Sheets("DATA").Range("K1").Value Sheets("検索").Range("L1").Value = Sheets("DATA").Range("L1").Value Sheets("検索").Range("M1").Value = Sheets("DATA").Range("M1").Value Sheets("検索").Range("N1").Value = Sheets("DATA").Range("N1").Value Sheets("検索").Range("O1").Value = Sheets("DATA").Range("O1").Value Sheets("検索").Range("P1").Value = Sheets("DATA").Range("P1").Value Sheets("検索").Range("Q1").Value = Sheets("DATA").Range("Q1").Value Sheets("検索").Range("R1").Value = Sheets("DATA").Range("R1").Value Sheets("DATA").Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:R2"), _ CopyToRange:=Sheets("結果").Range("A1"), _ Unique:=False Sheets("結果").Columns("A:R").AutoFit Application.ScreenUpdating = True End Sub

  • 複数のシートにまたがり、フィルタオプションの設定から値を抽出するマクロ

    複数のシートにまたがり、フィルタオプションの設定から値を抽出するマクロを組んでおります。 表示したくないシート(data,output)を非表示にしたら、エラーが出てしまいました。 非表示シートの状態で処理することはできませんでしょうか。 Sub Macro7() Application.ScreenUpdating = False Sheets("data").Select Columns("A:J").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ Sheets("マップ").Range("E2:N3"), Unique:=False Columns("A:J").Select Selection.Copy Sheets("output").Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Copy Sheets("マップ").Select Range("E5").Select ActiveSheet.Paste Range("H4").Select Sheets("data").Select Application.CutCopyMode = False ActiveSheet.ShowAllData Sheets("マップ").Select End Sub

その他の回答 (1)

  • 回答No.1
  • S-Fuji
  • ベストアンサー率36% (592/1624)

2000と2007との違いは判りませんが、On Error Gotoが有効になっていると、他の要因でのエラーが発生しても、「MSG」へ飛んでしまいます。  取りあえず、データがある状態、なおかつエラー処理を無効にし、確認してみましょう。  違うエラーが出ている可能性もあります。

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

質問者からのお礼

ありがとうございます。 他の要因のエラーで飛んでいました。

関連するQ&A

  • エクセルマクロVBAについて

    エクセルマクロVBAについて、こんなこと出来ますか? ■A列からAS列の1行目にヘッダー情報をもつデータベース ■A列に担当者名 ■A列にオートフィルタをかけて各担当ごとにデータを抽出したものを別シートに貼り付けて自動印刷したい ■担当者は都度変わるので、Criteria1:="xxx"というようには直接書けない(担当名を自動で抽出したい) ■担当者の数も都度変わる ■補足 一行のデータを特定の雛形に転記する必要があるので別シートに出したいです ちなみに、アナログで記録したコードは以下です。 Sub test1() Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="山田" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="斉藤" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="田中" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 End Sub これ、担当者の抽出を自動でなんとかなりませんか?

  • 印刷シートを分けたい

    excel2010を使用しています、今勉強中の初心者です、 dataシートに履歴を残すようにしています、dataシート列 L列に番号1が表示された場合のみSHEET4を印刷し、そうで無い場合SHEET5を刷したいですが、ご教授ください。 Sub rireki() Dim val(1 To 12) Dim lastRow As Long val(1) = Range("AH5").Value val(2) = Range("AJ3").Value val(3) = Range("AJ5").Value val(4) = Range("AK5").Value val(5) = Range("G2").Value val(6) = Range("AI5").Value val(7) = Range("B2").Value val(8) = Range("B5").Value val(9) = Range("E5").Value val(10) = Range("C3").Value val(11) = Range("V2").Value val(12) = Range("V3").Value Application.ScreenUpdating = False With Sheets("data") lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row End With Sheets("data").Range("A" & lastRow).Offset(1).Resize(, 12) = val Sheets("Sheet4").PrintOut Copies:=1, Collate:=True ActiveWorkbook.Save Application.ScreenUpdating = True End Sub

  • ExcelのVBAでの抽出

    初心者です。よろしくお願いいたします。 sheet1の"A2"~"C6"に簡単な表を作りました。 A列に人の名前が入力されています。 そこで、A列の名前が"花子"のデータだけを抽出 してSheet2へコピーしたいのです。 そこで試行錯誤の上、下のような記述をしました。 Sub 抽出() Application.ScreenUpdating = False Sheets("sheet2").Activate Sheets("sheet2").Columns("A:C").Clear With Sheets("Sheet1") .Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:="花子", CopyToRange:=Sheets("sheet1").Range("A2"), Unique:=False End With Application.ScreenUpdating = True End Sub しかし、うまくいきません(TT) エラー:400 とかでるんですけど なにがいけなんでしょうか・・。 他にもAdvancedFilterを使うさいに気をつけること がありましたらご指導ください。 (項目行の中のセルが統合されていたりすると うまくいかない・・・とかあるんでしょうか。) よろしくご指導ください。お願いいたします。

  • EXCEL2003 VBAを表示ロック

    Sheets("DATA")にあるデータを、Sheets("Branch").Range("B2:B20")にあるコード(数字)で順に抽出します。 それをSheets("Form")を複製したシートに貼ります。 複製シートに名前をつけ、保存します。 ここまでは問題なく、以下のVBAでできました。(だいぶ省略しましたが) Sub Make_BrCopy() Dim myCl As Range With Sheets("DATA") For Each myCl In Sheets("Branch").Range("B2:B10") Sheets("Form").Copy Before:=Sheets(1) Sheets(1).Name = myCl.Value .Range("A1:G1").AutoFilter Field:=2, Criteria1:=myCl.Value .UsedRange.SpecialCells(xlCellTypeVisible).Copy Sheets(CStr(myCl.Value)).Range("A1") Sheets(CStr(myCl.Value)).Copy ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & CStr(myCl.Value) & ".xls" ActiveWindow.Close Application.DisplayAlerts = False Sheets(CStr(myCl.Value)).Delete Application.DisplayAlerts = True .ShowAllData Next myCl End With End Sub ところが、少し困ったことがあります。 Sheets("Form")には、ワークシートモジュール、Private Sub Worksheet_Change(ByVal Target As Range) があるのです。 これを複製したワークシートにそのまま必要なのでそうしてあるのですが、できることなるら、VBAを表示ロックさせたいのです。 元のファイルではVBAProjectのロックでそうしているのですが、ワークシートをコピーして作成したあらたなBOOKはVBAを表示にロックにはなっていません。 丸見えです。 どうすればよいでしょうか? Excel2003です。 また、上記のVBAコードになにかご指摘のことなどありましたらそれもあわせて教えてください。

  • excel vba DATAの日集計

    excel vba DATAの日集計 いつもお世話になっています。 "DATA"シートのセル"D2"の日付を変えると表の数値が変わるようにしています。 その日毎のデータを"集計"シートの日別の表に飛ぶようにしているのですが、 1日分の転記するセル数が多く、Select Caseで31日分のコードを書くと、あまりにも プロシージャーが大きくなります。(Case1からCase31・・・結果分割してますが) FOR NEXT なのかな~、もっと効率のいい書き方がありましたらよろしくお願いします。 例:"集計"シート1日分は、9行となります。それぞれ"DATA"シートからの転記です。"DATA"シートのF5+F10,G5+G10~AC5+AC10までそれぞれの値を"集計"シートのG5からAD5まで、F6+F12,G6+G12~AC6+AC12までそれぞれの値を"集計"シートのG13からAD13までといった具合です (日の9行はそれぞれ決まったある行とある行の加算です、これが31日分の行があります) Sub macro() Dim myrng As Range Dim c As Range Set myrng = Sheets("DATA").Range("D2") For Each c In myrng Select Case c.Value Case 1 '1行目 Sheets("集計").Range("G5").Value = Sheets("DATA").Range("F5") + Sheets("DATA").Range("F10") | | Sheets("集計").Range("AD5").Value = Sheets("DATA").Range("AC5") + Sheets("DATA").Range("AC10") | | '9行目Sheets("集計").Range("G13").Value = Sheets("DATA").Range("F6") + Sheets("DATA").Range("F12") | | Sheets("集計").Range("AD13").Value = Sheets("DATA").Range("AC6") + Sheets("DATA").Range("AC12")

  • EXCELのシートを並べ替えすると・・・

    エクセルのシートを並べ替えようと思って こちらで調べてようやく並べ替えができるようになったのですが、幾つかあるデータの中で実行するとエラーが出るものがあります。 シートの名前は1日~31日&集計という構成なのですが、下記を実行すると実行エラー9:インデックスが有効範囲にありません!とでます…デバックを押すと Worksheets(CStr(Wwh.Cells(N, 1).Value)).Move After:=Sheets(N) のところが黄色になっています。 同じようなシートの構成があるデータで試してみると成功するものと失敗するものがありもう何がなにやら(;´Д`) 何か変更しないとだめなんでしょうか? 分かる人がいたらアドバイスお願いします。 Sub SortSheets() Dim Wwh As Worksheet Dim N As Integer Application.ScreenUpdating = False Sheets.Add Before:=Worksheets(1) Set Wwh = ActiveSheet For N = 2 To Worksheets.Count   Cells(N - 1, 1).Value = Worksheets(N).Name   Cells(N - 1, 2).Value = _   Application.GetPhonetic(Worksheets(N).Name) Next N Range("A1").CurrentRegion.Sort Key1:=Range("B1"), _   Order1:=xlAscending, Header:=xlNo, OrderCustom:=1 '昇順 'Range("A1").CurrentRegion.Sort Key1:=Range("B1"), _   Order1:=xlDescending, Header:=xlNo, OrderCustom:=1 '降順 For N = 1 To Range("A1").End(xlDown).Row   Worksheets(CStr(Wwh.Cells(N, 1).Value)).Move After:=Sheets(N) Next N For N = 2 To Worksheets.Count   If Worksheets(N).Visible = xlSheetVisible Then     Worksheets(N).Activate     Exit For   End If Next N Application.DisplayAlerts = False Wwh.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Set Wwh = Nothing End Sub

  • エクセルVBAでファイル保存失敗の原因?

    エクセル2010です。 Sheets("DATA")にある822件のデータを、D列のデータ(担当者名)をキーにフィルター抽出し、雛形のシートにコピーして、そのシートを別ファイルとして名前をつけて、指定したフォルダーのサブフォルダに保存するマクロです。(サブフォルダ名はデータのG列にある文字列です。) キーとなる担当の数は223です。 以下のコードで一応作動するのですが、同じデータを使っても2回に一回くらいの割合で保存ができず、 wb(1).SaveAs Filename:=SaveDir & "\" & bcde & "_" & Trim(myC.Value) & ".xlsx" のところで止まってしまいます。 エラーは 「実行時エラー1004 SaveAsメソッドは失敗しました。Workbookオブジェクト」 というものです。このとき、画面上ではあたらしいファイルが出来あがっております。しかしその出来てるファイルを手動で保存しようと思っても、 「○○○(ファイル名)は保存中にエラーが検出されました。いくつかの機能を削除または修復することによりファイルを保存できる場合があります」 とでてしまいます。 まだテスト段階で、同一のデータでテストしているのですが、止まるデータは30件目であったり、140件目であったり、まちまちです。2回に1回くらいは最後まで動き、すべて正しく作成され保存できているので、データの問題ではないと思います。 ほかにどんな問題が考えられるのでしょうか?とても困っています。 Sub TEST20151114()   Dim SaveDir As String, bcde As String, sbfdr As String   Dim wb(1) As Workbook   Dim i As Long, x As Long   Dim myRng As Range, myC As Range   Dim t      t = Time      Set wb(0) = ThisWorkbook   Set myRng = wb(0).Sheets("担当別").Range("B2:B224")   Application.ScreenUpdating = False   For Each myC In myRng     wb(0).Sheets("回答雛型").Copy After:=wb(0).Sheets("回答雛型")     wb(0).Sheets("回答雛型 (2)").Name = "回答シート"     With wb(0).Sheets("DATA")       .AutoFilterMode = False       .Range("A1:J1").AutoFilter       .Range("A1:J1").AutoFilter Field:=4, Criteria1:=myC.Value 'D列       .Range("A2", .Range("A2").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy Sheets("回答シート").Range("A2")       .ShowAllData       x = wb(0).Sheets("回答シート").Cells(Rows.Count, "A").End(xlUp).Row       .Range("A823:J827").Copy wb(0).Sheets("回答シート").Range("A" & x + 1) '予備5行追加     End With          With wb(0).Sheets("回答シート")       .Rows(x + 6 & ":" & .Rows.Count).Delete Shift:=xlUp       Application.Goto Reference:=.Range("A1"), Scroll:=True       bcde = CStr(Trim(.Range("E2").Value))       sbfdr = Trim(.Range("G2").Value) 'サブフォルダ名              .Move     End With          Set wb(1) = ActiveWorkbook          SaveDir = wb(0).Path & "\20151114\" & sbfdr '保存先     If Dir(SaveDir, vbDirectory) = "" Then       MkDir SaveDir '無ければサブフォルダ作成     End If          DoEvents          wb(1).SaveAs Filename:=SaveDir & "\" & bcde & "_" & Trim(myC.Value) & ".xlsx"     wb(1).Close (False)     myC.Offset(, 1).Value = x - 1          i = i + 1     Application.StatusBar = i & "/" & myC.Value     Set wb(1) = Nothing   Next myC      Set wb(0) = Nothing   Application.ScreenUpdating = True   MsgBox i & "個のファイルを作成しました。" & vbCrLf & Format(Time - t, "hh:mm:ss")   Application.StatusBar = "" End Sub

  • Excel フィルタオプション マクロ

    <Excel2013> フィルタオプションで抽出条件を加工し 別シート(抽出結果)に抽出したい。 検索条件で「文字を含む」の場合「=”=*"」など 抽出記号入力するのが分からない人の為に、 検索したい文字だけ入力してVBAで加工して データを抽出したいのですが、上手く加工出来ません。 どうかお知恵をお貸し下さい! ◎例題(実際は1000件位横に広いデータです) 【シート名:青森】 住所            処理No.     青森県青森市南町・・・   10  ・ 青森県五所川原市北町    10 【シート名:秋田】 住所            処理No.     秋田県大館市北町・・・   20  ・ 秋田県秋田市栄町・・・   10 【シート名:抽出結果】      C2      D2    F2      G2 検索条件 抽出シート  住所    抽出シート  住所      秋田    栄              <抽出実行ボタン押下> ★検索条件:シート=秋田 and 住所に『栄』を含むデータを抽出 同シート【A7セル】を基準に抽出データを表示 Sub 抽出() Dim Sh As Worksheet ’* Set Sh = Sheets("抽出結果") Sh.Rows("7:7").Select Range(Selection, Selection.End(xlDown)).Select ' Sh.Range("A7").Select ★検索条件範囲:E2/F2へ加工した条件を設定  '** 抽出条件 If Sh.Range("C2").Value <> "" Then Sh.Range("F2").Value = "=” & Sh.Range("C2").Value End If If Sh.Range("D2").Value <> "" Then Sh.Range("G2").Value = "=”&"=*" & Sh.Range("D2").Value & "*" End If ’* Select Case Range("C2").Value Case "青森" Sheets("青森").Range("1:cx2000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("F1:G2"), CopyToRange:=Range("A7"), Unique:=False Case "秋田" Sheets("秋田").Range("1:Cx2000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("F1:G2"), CopyToRange:=Range("A7"), Unique:=False End Select End Sub

  • マクロで”1004”エラー

    初めまして、現在エクセルでマクロを使用している初心者です。本を見ながら自己流でやっているのですが、どうしても問題が解決しないものがありまして質問させていただきました。シート1を”データベース”、シート2を”検索結果”としています。 Sub OutputData() Dim strDate1 As String Dim strDate2 As String Dim StrJouken1 As String Dim StrJouken2 As String strDate1 = Range("AU2").Value strDate2 = Range("AU3").Value StrJouken1 = ">=" & strDate1 StrJouken2 = "<=" & strDate2 Application.ScreenUpdating = False Sheets("検索結果").Activate Cells.Clear With Sheets("データベース") .Range("A2").AutoFilter Field:=3, _ Criteria1:=StrJouken1, Operator:=xlAnd, Criteria2:=StrJouken2 .Range("A2").CurrentRegion.Copy _ Destination:=Sheets("検索結果").Range("A1") .Range("A2").AutoFilter End With Sheets("検索結果").Columns("A:AF").AutoFit Application.ScreenUpdating = True End Sub というコードで最初は問題なかったのですが、急に”実行時エラー1004 RangeクラスのAutofiterメソッドが失敗しました”という表示が出るようになりました。何を直せばよいのか教えを乞いたいのですが・・・

  • Excel VBAデータ登録のスピードアップしたい

    下記のようなコードがあります。 ■input データ閲覧・登録・編集シート ■data データを格納するシート inputシートとdataシートでdataの受け渡しを行っているのですが、データレコードを切り替えるだけで20秒ちょっとかかるため、作業効率が悪いです。 この時間を1&#65374;2秒ぐらいまで減らすには、どのように修正すれば、いいでしょうか?どうかアドバイスをお願いいたします。 Private Sub datatouroku() ’データを登録する Dim touroku As Integer Dim fRange As Range Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows) touroku = fRange.Row '検索されたNoの行位置を求める Sheets("data").Cells(touroku, 1).Value = Range("BC1:BE1").Value Sheets("data").Cells(touroku, 2).Value = Range("AX1").Value Sheets("data").Cells(touroku, 3).Value = Range("I4").Value   '・・・上記のデータが全部で256件あります。 End Sub &#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293;&#65293; Private Sub hyouji() 'データを表示させる Dim fRange As Range Dim kensaku As Long Set fRange = Sheets("data").Columns(1).Find(What:=Range("BC1").Value, _ LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)    If (fRange Is Nothing) Then '見つからなかった?    MsgBox "入力された顧客コードが存在しません。", vbExclamation    Exit Sub    End If    kensaku = fRange.Row '検索された顧客DCの行位置を求める     Range("BC1:BE1").Value = Sheets("data").Cells(kensaku, 1).Value     Range("AX1").Value = Sheets("data").Cells(kensaku, 2).Value    Range("I4").Value = Sheets("data").Cells(kensaku, 3).Value     '・・・上記のデータが全部で256件あります。 Set trg = Sheets("data").Cells(kensaku, 1) End Sub