- ベストアンサー
インプット関数を使って・・（応用）
インプット関数を使って・・でご教授頂き、解決したのに複雑になったら何故か転記できません。すみませんが、ふたたびご教授をいただきたいです。 シート１（データシート） A列に通し番号（80001,80002,・・）B列に氏名、C列以降もデータがあり J列に電話番号があります。インプットボックスに通し番号（80001などの番号）を入力すると80001に対応する氏名を（B２９へ）、電話番号を（F２９へ）としたいのですが、シート２（転記シート）へが表示できません。（一応「転記しました」と表示するのですが？） データシートの２行目に項目、３行目からデータが入っています。 Sub 転記() Dim Numv As Variant Dim FindNum As Long Dim wsNum As Long Dim sNumv As Range '検索する受付番号を取得 FindNum = InputBox("受付番号は", "番号の入力") 'キャンセルの場合の処理 If Len(Trim(FindNum)) = 0 Then Exit Sub '"受付番号"列番号の自動取得 Set sNumv = Worksheets("データシート").Cells.Find(What:="受付番号") '該当する受付番号は見つかったか? If sNumv Is Nothing Then MsgBox "受付番号がありません！", vbOKOnly, "エラー" 'プログラム終了 Exit Sub Else End If '該当番号があった場合転記 With sNumv .Copy.Offset(0, 2).Value = Worksheets("転記シート").Range("B29").Value .Copy.Offset(0, 10).Value = Worksheets("転記シート").Range("F29").Value End With '転記成功メッセージを表示 MsgBox "転記しました", vbInformation Worksheets("転記シート").Select End Sub
- hirosatonn
- お礼率41% (38/91)
- オフィス系ソフト
- 回答数7
- ありがとう数2
- みんなの回答 （7）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (6)
- imogasi
- ベストアンサー率27% (4737/17068)
- KenKen_SP
- ベストアンサー率62% (785/1258)
あ、、どうも。 Wendy02 さんがフォローして下さっていることに気づかず、同じような内容の投稿をしてしまいました。 ありがとうございます。
お礼
KenKen_SP さん 最後までありがとうございました。 望んでいたものが、十分すぎるくらい出来ました。 又、お力を貸してもらうことがあるかもしれません。その時は、宜しくお願いいたします。
- KenKen_SP
- ベストアンサー率62% (785/1258)
- Wendy02
- ベストアンサー率57% (3570/6232)
KenKen_SP さんには、申し訳ないけれども、 ＞ '受'受付番号の検索範囲を取得(A1～A列最終行まで） ＞ Set rngSA = Sheets("データシート").Range("A1", Range("A65536").End(xlUp)) 基本的なことですが、エラーメッセージのとおり、Range("A65536")のオブジェクトが定まっていません。Rangeオブジェクトは、ふたつのクラスがありますが、なしにすると、Application となって、具体的には、ActiveSheet に属してしまうので、最初の部分、Sheets("データシート").Range("A1")との整合性が合いません。 そのコードが通る時は、ActiveSheetと、Sheets("データシート") が一致する時、つまり、ActiveSheet が、データシートの時にのみになります。 ですから、この場合、正式に書くなら、 Set rngSA = Sheets("データシート").Range("A1",Sheets("データシート"). Range("A65536").End(xlUp)) となりますが、可読性が落ちますので、省略して、以下のようにしたらよいと思います。 With Sheets("データシート") Set rngSA = .Range("A1", .Range("A65536").End(xlUp)) End With と「．（コンマ）」を入れてください。なるべく、Withステートメントは使ったほうがよいですね。 よけいなことでしたら、すみません。
お礼
Wendy02 さんVBA駆け出しの者に分かりやすいご説明ありがとうございました。おかげさまで望んでいたものが、出来ました。
- KenKen_SP
- ベストアンサー率62% (785/1258)
> Set rngSA = Sheets("データシート").Range("A1", Range("A65536").End(xlUp)) > で『実行時エラー'9' インデックスが有効範囲にありません』 Sheets("～") はシート名を指定する命令ですが、この場合「データシート」 という名前のシートが無いとエラー、 『実行時エラー'9' インデックスが有効範囲にありません』 が発生します。 コード内に書かれたシート名と実際のシート名が一致しているか確認して 下さい。
補足
すみませんです。コード内に書かれたシート名と実際のシート名が一致していないのを確認し忘れました。（寝起きだったもので・・） 実際のシート名に変えて、実行すると、１回だけ成功しましたが、別の数字（受付番号）をすると > Set rngSA = Sheets("データシート").Range("A1", Range("A65536").End(xlUp)) の部分が、 今度は、'1004'アプリケーション定義またはオブジェクト定義エラーです。 私の浅はかな知識では、駄目です。
- Wendy02
- ベストアンサー率57% (3570/6232)
関連するQ&A
- 転記したデータを基にして検索表示させる方法
下記のようにシートＡのデータをシートＢ（Ａ列）へ転記した後に、転記したデータを基にしてデータベースから検索した結果をシートＢ（Ｂ列）に表示したいのですが、マクロを実行すると「型が一致しません」というエラーになります。 どのようにしたらエラーにならないのか… どうぞよろしくお願いします。 Sub レコード転記() Dim myTbl As Range, sakiRng As Range Set myTbl = Sheets("Ａ").Range("B6:B81") Set sakiRng = Sheets("Ｂ").Range("A5") myTbl.Copy sakiRng.PasteSpecial xlPasteAll sakiRng.PasteSpecial xlPasteColumnWidths End Sub Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim r As Variant, myRange As Range Set myRange = Workbooks("入力フォーム.xls").Worksheets("一覧表").Range("社名") With Target If Target.Column = 1 Then r = Application.WorksheetFunction _ .Match(Target.Value, myRange, 0) Cells(Target.Row, 2) = Workbooks("入力フォーム.xls").Worksheets("一覧表").Range("N1").Offset(r - 1).Value End If End With End Sub
- ベストアンサー
- Visual Basic
- excel ユーザーフォームでシートごとに転記2
先日ユーザーフォームへの転記について質問させていただきました。 ご回答いただき、ありがとうございました。 今度はオプションボタンで選択したときに、シートごとに転記する方法を 教えていただけますでしょうか。 ユーザフォーム上で、オプションボタンを選択。 OptionButton1・・・シート１へ転記 OptionButton2・・・シート２へ転記 これをOKボタンを押したときに転記するようにしたいと思っています。 Private Sub OK_Click() Dim CLrow As Long Dim KYrow As Long CLrow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row KYrow = Worksheets("Sheet2").Range("A65536").End(xlUp).Row If OptionButton1.Value = True Then Worksheets("Sheet1").Range("A" & CLrow).Value = .TextBox1.Value ElseIf OptionButton2.Value = True Then Worksheets("Sheet2").Range("A" & KYrow).Value = .TextBox1.Value End With End Sub ここまでやってみたのですが「参照が不正または不完全です」 と出てしまいます。 どなたかご教示願います。 よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- エクセルの簡単なマクロ機能を追加したいのです
既存のエクセルマクロ（Sub チェック()以下です）に下記の内容のマクロを付け足したいです。 教えていただけないでしょうか。 付け足したい条件です： Sheet2のC列に 0 があれば Sheet1のB列に 愛 と（[太字]でセルの背景色を[灰色25%]にして）入れたいです 恐れ入りますがご存じの方がいらっしゃりましたら教えていただきたく何卒よろしくお願いいたします。 ----------------------------------------------- Sub チェック() Dim Ws1 As Worksheet Dim Ws2 As Worksheet Dim myRange1 As Range Dim myRange2 As Range Dim c1 As Range Dim c2 As Range Dim myCt As Long Set Ws1 = Worksheets("Sheet1") Set Ws2 = Worksheets("Sheet2") Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp)) Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp)) For Each c1 In myRange1 myCt = 0 For Each c2 In myRange2 If c2.Value = c1.Value Then If c2.Offset(, 1).Value = "" Then c1.Offset(, 1).Interior.ColorIndex = 3 Else c1.Offset(, 1).Value = c2.Offset(, 1).Value End If myCt = myCt + 1 End If Next c2 If myCt > 1 Then c1.Offset(, 1).Interior.ColorIndex = 10 Next c1 Set Ws1 = Nothing Set Ws2 = Nothing Set myRange1 = Nothing Set myRange2 = Nothing End Sub
- 締切済み
- その他MS Office製品
- マクロに関するエラー（オブジェクトが必要です。）
マクロは始めてで、いろいろ調べながら作ってみたのですが、 Set検索値の行でオブジェクトが必要ですというエラーが出て、 先に進めなくなりました。 申し訳ないのですが、何方かエラーの対処法を教えていただけないでしょうか。 よろしくお願いします。 ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ Sub test() Worksheets("2月分").Activate Dim 検索値 As Integer Set 検索値 = Worksheets("2月分").Cells(4, 18) Worksheets("テスト").Activate Dim B As Range Dim C As Range For Each B In Range("B13,B413") ' 第一条件 If B.Value >= 検索値 Then GoTo Continue End If ' 第二条件 If B.Offset(0, 1).Value < 検索値 Then ' Offset(0, 1) は B列の隣のC列の値を取得 GoTo Continue End If Dim aValue As String aValue = B.Offset(0, 2).Value Worksheets("2月分").Cells("D19").Value = aValue Continue: Next End Sub
- 締切済み
- その他（ビジネス・キャリア）
- 処理中メッセージを出しておきたいのですが
ある処理を実行するのに実行中ユーザーフォームで％表示をして終了と同時に閉じるVBAを・・コードは次のようにしています。 Sub 転記() Dim strCode As String Dim rngSA As Range Dim rngFC As Range strCode = Application.InputBox("受付番号は", "番号の入力", Type:=2) UserForm２.Show vbModeless 'キャンセルの場合の処理 If UCase$(strCode) = "FALSE" Then Exit Sub '受付番号の検索範囲を取得 With Sheets("sheet") Set rngSA = .Range("A1", .Range("A65536").End(xlUp)) End With '受付番号の検索範囲から入力された受付番号を探す Set rngFC = rngSA.Find(What:=strCode, LookAt:=xlWhole) '該当する受付番号が無ければ警告を表示して終了 If rngFC Is Nothing Then MsgBox "番号がありません！", vbOKOnly Or vbCritical, "エラー" Exit Sub End If '該当番号があった場合、氏名等転記 With Sheets("sheet2") .Range("F31").Value = rngFC.Offset(0, 4).Value 'TEL .Range("F29").Value = rngFC.Offset(0, 1).Value '氏名 End With '後始末：変数をクリア Set rngFC = Nothing Set rngSA = Nothing 'メッセージ用のユーザーフォームを閉じる UserForm２.Hide '転記成功メッセージを表示 MsgBox "終わりました。", vbInformation 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
- ベストアンサー
- オフィス系ソフト
- 2つのマクロを1つにしたい
いつもお世話になっております。 今回もよろしくお願いいたします。 (1)14のシートがあるのですが、データーのある2から14までのシートを印刷する。 (2)上記のうち、ｃ列のデーターで連続しているセルを結合する。 (1)と(2)を合わせて1つのマクロにしたいのですが、アクティブシート１つにしか(2)のマクロが動きません。 下記のコードの間違いを教えてください。 Sub 契約書目次印刷() Dim Sh As Worksheet Dim t As Long Dim i As Range t = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'データーのあるシートだけ印刷 For Each Sh In Worksheets(Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14)) If Sh.Range("A2").Value <> "" Then '連続データーセル結合 For Each i In Range("C1:C" & t) If i.MergeArea(1).Value = i.Offset(1).Value Then Range(i.MergeArea, i.Offset(1)).Merge End If Application.DisplayAlerts = False Next i End If Sh.PrintPreview Next Sh End Sub
- ベストアンサー
- Excel（エクセル）
- プログラムの作り方
まったくの素人です。 1列にあるデータをキーにして情報の抽出をしたいのですが うまくコードが書けません。 何卒、助勢頂ければ幸いです。 よろしくお願いいたします。 具体的な内容) B列 C列 x 11 ・・適当な不要なデータが数行 y (2A) ・・適当な不要なデータが数行 x 12 ・・適当な不要なデータが数行 y (44) ・・適当な不要なデータが数行 x 39 ・・適当な不要なデータが数行 y (7) ・・適当な不要なデータが数行 から、xのデータとyのデータの表を作りたい。 ただし、yのデータ()内はB列のyの次の行。 できれば、抽出したデータはシート2に並べたい。 Sub macro() Dim a As String Dim b As Variant Dim c As range Dim i As Integer a = x b = "y" i = 1 Worksheets("sheet1").range("B1").Activate For i = 1 To 5000 With ActiveCell If .Value = a Then ActiveCell.Offset(0, 1).Copy Worksheets("sheet2").Select Cells(i, 1).Select ActiveSheet.Paste Sheets("sheet1").Select Else ActiveCell.Offset(1, 0).Activate End If If .Value = b Then ActiveCell.Offset(1, 0).Copy Worksheets("sheet2").Select Cells(i, 2).Select ActiveSheet.Paste Sheets("sheet1").Select Else ActiveCell.Offset(1, 0).Activate End If End With Next End Sub
- ベストアンサー
- Visual Basic
- 列を変更して転記したいのですが。
すみません、誰か教えていただけませんか。 A列に値が入力がされていて、その値をF列に転記していき 15行までいけば２列横にズレて転記していき更に、15行で 2列横と続けたいのですがうまく出来ません。 下記のように記述してみたのですが、値が置き換わるだけで 転記出来ません。 誰か教えて頂けませんでしょうか。 Sub TEST() Dim i As Long, ii As Long Dim myR As Long myR = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row ii = 5 For i = 1 To myR Cells(1, ii).End(xlUp).Offset(0, 1).Value = Cells(i, 1).Value If Cells(1, ii).End(xlUp).Row = 15 Then ii = ii + 2 End If Next i End Sub 宜しくお願いします。
- ベストアンサー
- その他MS Office製品
- マクロで分と秒だけのデター抽出を教えてください。
マクロで分と秒だけのデター抽出を教えてください。 シート1のA列に5:15:30以下にランダムな時刻が入力されています。（時間と分と秒が表示になっています。） それを分と秒だけシート2のA列に表示したいと思っています。 とりあえず、データーだけでもシート2に移せたら（転記）と思い以下の記述をしたのですが、 これでは、時刻データーも29035.0658333333となったりA列以外のデーターも 全部転記してしまいます。 誰か教えて頂けませんでしょうか？お願いします。 Sub データー抽出() Dim LastRow As Long Dim k As Long LastRow = Worksheets("シート1").Range("A65536").End(xlUp).Row For r = 2 To LastRow Worksheets("シート2").Rows(r).Value = Worksheets("シート1").Rows(r).Value Next r end sub
- ベストアンサー
- オフィス系ソフト
- mfc-j898nでカラーにむらが生じる問題について相談します。
- 質問者の環境はWindows10で有線LAN接続、光回線を使用しています。
- ブラザー製品に関するトラブルで、黒が緑色になるという現象が起きています。
補足
KenKen_SP さん今回も色々と助けていただきありがとうございます。 さっそく実行させていただいたところ、 ＞Set rngSA = Sheets("データシート").Range("A1", Range("A65536").End(xlUp)) で 『実行時エラー'9' インデックスが有効範囲にありません』 になります。