- ベストアンサー
実行時エラーの対処とセルの配置変更に伴うマクロ修正
- 条件が一致時の転記マクロの実行時エラーの対処方法について相談です。
- エクセルのセルの配置が変わったため、マクロを修正しても実行時エラーが発生しています。
- 作成したマクロは、IDデータ.xlsの時間とIDが一致したものをID管理票.xlsのD列に転記する処理を行うものです。
- samohankinpo
- お礼率100% (10/10)
- Excel（エクセル）
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- VBA マクロ シート 転記
はじめまして。VBA初心者です。今シート１のA列1行目セルにA社、A列2行目にB社、A列3行目にC社と・・ざっと1000行程あり、それぞれB列には値があります。この値をシート２のＢ列に転記したいと思っています。ただ、毎月シートを追加していきますので、左隣のシートから転記しなければなりません。シート２の項目は同じA列とB列で構成されています。A列の値が多少前後するので、FINDを使って以下のようなプログラムを作りました。ただ、左隣のシートから転記とう内容をどうやって追加したら良いのかがわかりません。Previous をどこかに使えばできるのかなとも思うのですが、その方法がわかりません。 Sub 転記() Dim ws As Worksheet, ws1 As Worksheet, r As Range, r1 As Range Dim LastRow As Long, i As Long, er As Long, wkey As String Set ws = Worksheets("Sheet1") Set ws1 = Worksheets("Sheet2") LastRow = ws.Range("A1").End(xlDown).Row er = ws1.Range("A1").End(xlDown).Row Set r = ws.Range("A1:A" & LastRow) For i = 1 To er wkey = ws1.Range("A" & i) Set r1 = r.Find(What:=wkey, LookIn:=xlValues, LookAt:=xlWhole) If Not r1 Is Nothing Then ws1.Range("B" & i) = r1.Offset(, 1) End If Next Set r1 = Nothing Set r = Nothing Set ws = Nothing Set ws1 = Nothing End Sub どなたか詳しいお方いらっしゃいましたら、初心者の私に教えて頂けませんでしょうか？宜しくお願いします。
- ベストアンサー
- Visual Basic
- マクロ 2つのブック 条件一致 転記
2つのエクセルブックがあります。 1つがIDデータ表になって、IDと払い出し内容と日付の３つがあります。 もう１つがID管理票で、IDを担当ごとに管理している票です。 IDデータ表のIDとID管理票のIDを一致したら IDデータ表の払い出し区分の単語を基準に（新規・変更・廃止） ID管理票.xlsに乗っているIDの横に 払い出し区分の単語の条件で 新規の場合,ID右隣に日付を転記 変更の場合,IDの２つ右隣に日付を転記 廃止の場合,IDの３つ右隣に日付を転記を行いたいのですが FINDメソッドを使い、行のB列の区分で判定して、日付を書き入れるのと Offセットでセルの位置を指定するのと「IDデータ表」.xlsの特定の範囲のデータを繰り返す というアドバイスをもらいましたが 繰り返し処理（ForやLoop）をよく理解していないからだと思います。 どなたかご教示くださいますでしょうか。 下記に簡素でありますが構成状態と 処理の概要と画像添付させて頂きます IDデータ表.xls A列 B列 C列 1 ID番号 払い出し区分 日付 2 110001241 新規 10/2 3 120000065 変更 10/3 4 190000036 廃止 10/4 ↓ 以下100行くらい続いています ID管理票.xls ID番号の場所がバラバラで AO列にあったりBC列にあったりしています。 また、ID管理票にすでに日付が入っていることもありますが それはそのまま上書きで問題ありません。 110001241, 10/2 （新規区分なのでIDの右隣に日付を転記） 120000065, 空白 10/3 （変更区分なのでIDの右２つ目に日付を転記） 190000036, 空白,空白,10/4 (廃止区分なのでIDの右３つ目に日付を転記） お手数ですがよろしくお願いいたします
- ベストアンサー
- Excel（エクセル）
- 横にコピーするには・・。
教えてください・・。 01.xls・02.xls・03.xlsとあり、その中のシート（01・02・03）をコピーして、全部というシートにまとめたいと思っています。 列にデータを追加したいのですが、行にデータが追加されてしまいます・・。 どうしたらいいのか教えてください。 01のシートがＡからＤまで 02のシートがＥからＧまで 03のシートがＨからＬまで とコピーをしたいと思っています・・。 --------- PathName = ThisWorkbook.Path & "\" ArrBook = Array("01.xls", "02.xls", "03.xls") For i = LBound(ArrBook) To UBound(ArrBook) Workbooks.Open PathName & ArrBook(i) Next Set WS(1) = Workbooks("01.xls").Worksheets("01") Set WS(2) = Workbooks("02.xls").Worksheets("02") Set WS(3) = Workbooks("03.xls").Worksheets("03") Set WS(4) = ThisWorkbook.Worksheets("全部") With WS(4) .Cells.ClearContents .Cells(1, 1) = "Ａ" .Cells(1, 2) = "B" .Cells(1, 3) = "C" .Cells(1, 4) = "D" .Cells(1, 5) = "E" .Cells(1, 6) = "F" .Cells(1, 7) = "G" .Cells(1, 8) = "H" .Cells(1, 9) = "I" .Cells(1, 10) = "J" .Cells(1, 11) = "K" .Cells(1, 12) = "L" .Cells(1, 13) = "M" .Cells(1, 14) = "N" .Cells(1, 15) = "O" .Cells(1, 16) = "P" .Cells(1, 17) = "Q" LastRow(1) = WS(1).Range("A65536").End(xlUp).Row LastRow(2) = WS(2).Range("A65536").End(xlUp).Row LastRow(3) = WS(3).Range("A65536").End(xlUp).Row For i = 1 To 3 LastRow(4) = .Range("A65536").End(xlUp).Row + 1 WS(i).Rows("2:" & LastRow(i)).Copy .Cells(LastRow(4), 1) LastRow(4) = .Range("A65536").End(xlUp).Row End With For i = LBound(ArrBook) To UBound(ArrBook) Workbooks(ArrBook(i)).Close SaveChanges:=False Next End Sub
- ベストアンサー
- オフィス系ソフト
- Excel マクロ 値の転記
Excel マクロ 値の転記 Sheet2をSheet1に転記したいのですが、A列だけは3回同じ値を転記 するのには、※をどのように変えたらいいのでしょうか？ 宜しくお願い致します。 〔Sheet1〕転記先 Ａ Ｂ あ 10 あ 20 あ 30 い 40 い 50 〔Sheet2〕転記元 Ａ Ｂ あ 10 い 20 う 30 え 40 お 50 Sub テスト() Dim i As Long For i = 1 To 30 '↓※ココをどう書いて良いのかが分かりません Worksheets("Sheet1").Cells(i, "A") = Worksheets("Sheet2").Cells(i, "A") Worksheets("Sheet1").Cells(i, "B") = Worksheets("Sheet2").Cells(i, "B") Next i End Sub
- ベストアンサー
- その他MS Office製品
- ２つのものが一致時に転記するマクロ
いつもお世話になります。 ここのサイトで ２つのブックでIDが一致したら 横にある文字を転記するというマクロがあるのですが 同じIDが続いても転記先のエクセルに全て転記したいと質問させて頂き そのマクロを使わせて頂いたのですが ＩＤと時間を一致したものを転記させなければいけなくなりました Ａ列の時間とＢ列のＩＤを一致したときに 大元に転記させるのは、変数で2つの項目を設定して 確認させればいいのかと思っていましたが上手くいきません 更に、データ量が多いので マクロを動かすたびに応答なしになるので コードをfindから別なコードを変えたほうがよろしいのでしょうか？ 下記にマクロのコードと構成と画像を記述させて頂きます お手数ですがご教授して頂けないでしょうか？ 恐縮ですがよろしくお願いいたします。 Sub 転記改造() Dim w0 As Worksheet, w1 As Worksheet Dim h As Range, Target As Range Dim i As Range, Target1 As Range Dim FirstAddress As String Set w0 = Workbooks("IDデータ.xls").Worksheets(1) Set w1 = Workbooks("ID管理票.xls").Worksheets(1) For Each h In w0.Range("A2:A" & w0.Range("A65536").End(xlUp).Row) For Each i In w0.Range("B2:B" & w0.Range("A65536").End(xlUp).Row) If h.Offset(, 1).Value = "確認" Then Set Target = w1.Range("D11:D60000").Find(what:=h.Value, LookIn:=xlValues, lookat:=xlWhole) If Not Target Is Nothing Then FirstAddress = Target.Address Do If Target.Offset(, -1).Value = "" Then Target.Offset(, -1) = "確認" Exit Do Else Set Target = w1.Range("D11:D60000").FindNext(Target) End If Loop While FirstAddress <> Target.Address End If End If Next next End Sub
- ベストアンサー
- Excel（エクセル）
- 条件にて行削除をするをマクロで高速化したい
シート（最初）のA,B,C列を連結した値と シート（残）のA,B,C列を連結した値を照合させ 同じ値の場合は シート（残）の該当行を削除です。 シート（最初）は6,182行 シート（残）は7,561行です。 VLookupを使って処理時間5分です。 VLookupを使わない記述で25分です。 20,000行位のデータを処理したいのですが時間が不安です。 別スレで 「VLookupで処理3分をdictionaryオブジェクトで1秒以内にする方法」を 教えていただきましたが、流用ができません。 シート（残）内にもシート（最初）内にも重複行はありません。 私の記述は「F列を検索用に使用」となっていて F列にデータがある場合、都度記述を書換えないと 使えないので、そこも対応したいです。 照合させる値はA,B,Cの連結値というのは変わらないのですが データがある範囲は都度変化する為です。 ・A～E列とかA～H列とか ・シート残はA～E列、シート最初はA～G列とか 記述そのものを教えてください。よろしくお願いします。 Sub 自動重複削除F列使用() 'シート（最初）のA,B,C列とシート（残）のA,B,C列が一致した行は 'シート残の行を削除 'F列を検索値として使用。 Dim Line As Long Dim LastRow As Long Dim myRange As Range Dim Flag 'シート「最初」のF1に、A,B,C列を結合した値を転記 With Sheets("最初") Set myRange = .Range("F2:F" & .Cells(Rows.Count, "A").End(xlUp).Row) .Range("F2").FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]" 'シート「最初」のF2からデータのあるところまで 'F1の規則でデータ貼付 .Range("F2").AutoFill Destination:=myRange End With 'シート「残」のF1に、A,B,C列を結合した値を転記 Sheets("残").Select LastRow = Cells(Rows.Count, "A").End(xlUp).Row Range("F2").FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]" 'シート「最初」のF2からデータのあるところまで 'F1の規則でデータ貼付 Range("F2").AutoFill Destination:=Range("F2:F" & LastRow) On Error Resume Next '双方のシートのF列を照合させ、ヒットした行は 'シート「残」から行削除をする For Line = LastRow To 2 Step -1 Flag = WorksheetFunction.VLookup(Cells(Line, 6).Value, myRange, 1, 0) If Err.Number = 0 Then Rows(Line).Delete xlUp Else Err.Clear End If Next Line '検索に使用したＦ列を削除 Sheets("残").Select Columns("F:F").Select Selection.Delete Shift:=xlToLeft Sheets("最初").Select Columns("F:F").Select Selection.Delete Shift:=xlToLeft Sheets("残").Select Range("A1").Select End Sub ●別方法 Sub 自動重複行削除F列未使用超遅() 'VLOOKUP無 'シート（最初）のA,B,C列とシート（残）の 'A,B,C列が一致した行はシート（残）の行を削除 Dim ws1, ws2 As Worksheet Dim i, j As Long Set ws1 = Worksheets("最初") Set ws2 = Worksheets("残") For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row For j = ws2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 If ws1.Cells(i, 1) = ws2.Cells(j, 1) And ws1.Cells(i, 2) = ws2.Cells(j, 2) And _ ws1.Cells(i, 3) = ws2.Cells(j, 3) Then ws2.Rows(j).Delete (xlUp) End
- ベストアンサー
- オフィス系ソフト
- マクロ 値の転記 再度
マクロ 値の転記 再度 昨日はkyboさんに解答を頂き大変助かりました。 ありがとうございました。 教えて頂いたコードを別のマクロでも活用しよう思ったのですが どのように改変していけばいいのかまた悩んでいます。 度々で申し訳ありませんが、どなたか宜しくお願い致します。 やりたいこと 転記元のBに0以外の数字が入っている場合、転記先のA列に 同じ値を常に5回転記させたい。 "あ"を5回転記→1行あける→"う"を5回転記→(続く・・・) ★Sheet1 転記先（7行目から転記したい） Ａ ------------------- 7 あ 8 あ 9 あ 10 あ 11 あ -------------------- 12 空行 -------------------- 13 う 14 う 15 う 16 う 17 う -------------------- 18 空行 -------------------- 19 以下 5つの纏まりの枠が300行位まで続く ★Sheet2 転記元（5行目からデータがある） Ａ Ｂ -------------------- 5 あ 6 あ 7 あ計 100 -------------------- 8 空行 -------------------- 9 い 10 い 11 い 12 い計 0 -------------------- 13 空行 -------------------- 14 う 15 う 16 う 17 う計 500 -------------------- 18 空行 19 （以下、続く） Sub テスト() Dim i As Long '転記元のデータ開始行は5行目 For i = 5 To 300 '転記元のB列が0以外 If Worksheets("転記元").Cells(i, "B") <> 0 Then Worksheets("転記先").Cells((i - 1) * 5 + 1, "A").Resize(5) _ = Worksheets("転記元").Cells(i, "A") End If Next i End Sub
- ベストアンサー
- その他MS Office製品
- 条件のあったシートへデータを転記するマクロ
よろしくお願いします。 ブック内にシート名でマスターシートと在庫日報入力シートの2つがあります。在庫日報シートのA1に日付、A列3行目以降に商品コード、B列3行目以降に各商品名、F列3行目以降に各商品の在庫数量が入っており、毎日更新されます。マスターシートには縦A列3行目以降に日付が入っており、また横1行目（A1,B1,C1....）に各商品名が百以上記載されています。今まで、以下のマクロで在庫日報入力シートの在庫数量をマスターシートの対応するセルに転記していました。（縦の日付を検索し、横の商品名を検索し対応する場所に在庫数量を転記） Private Sub CommandButton1_Click() Application.DisplayStatusBar = True Dim LastR, idxR As Long, trgR, trgC If MsgBox("日付は正しいですか", vbQuestion + vbOKCancel) = vbOK Then With Worksheets("在庫日報入力") LastR = .Range("A65536").End(xlUp).Row trgR = Application.Match(.Cells(1, 1), Worksheets("マスター").Range("A:A"), 0) For idxR = LastR To 3 Step -1 trgC = Application.Match(.Cells(idxR, 1), Worksheets("マスター").Range("1:1"), 0) If IsNumeric(trgR) And IsNumeric(trgC) Then Worksheets("マスター").Cells(trgR, trgC + 1) = .Cells(idxR, 6) Else .Cells(idxR, 1).Interior.ColorIndex = 3 End If Application.StatusBar = "マスターシートに転記中・・・進行状況 " & idxR & "" Next idxR End With Application.StatusBar = False MsgBox "終了しました。(処理件数=" & LastR- 3 & "件)", vbOKOnly: Exit Sub End If End Sub 今までこれで良かったのですが、今度、マスターシートを削除して、各商品名毎にシートを作成します。そのため、それぞれの商品名シートに在庫日報シートのデータを転記するように変えたいのです。商品名シートはそれぞれA列3行目以降に日付が、となりのB列に在庫数が入るようになっています。 在庫日報シートの各商品に対応した商品名シートを見つけて、そのA列から在庫日報と同じ日付を見つけて、その行のB列に在庫日報シートの在庫数量を転記する。というものです。商品名シートは百以上あり名前は文字列です。 今までのマクロは教えてgooで教えていただきながら作りました。すいませんが、またご教授をお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロで転記
シート１とシート２があり、 シート１の20Aから39Lまでのセルの中に情報を書き込んでいます。 シート１の20Lから39LのL行で、数値が入っているセルがあれば、その行のA、B、I、L列と、J2、A7を取り出し、シート２の２行目から下に転記していくのですが、 シート２のA列にはシート１のJ2を、B列にはシート１のA7を、C列以降は、シート１のA、B、I、Lを入れるようにします。 また同じ条件がシート１で発生すれば、シート２の3行目以降に転記していく感じです。 どのようにすればいいでしょうか。
- ベストアンサー
- その他MS Office製品
- 【Excel VBA】条件に合うデータの転記
Excel2003を使用しています。 2つのシート間の特定の範囲内で、条件に合うデータを転記したいのですが… Sheet1(A1:C41) ← 一定範囲 Sheet2(選択範囲) ← 都度、選択範囲取得 Sheet2の選択範囲内で、A列とB列の値が、Sheet1のA列とB列のそれぞれの値と一致した場合、Sheet1のC列の値をSheet2のE列に転記したいのですが、こういう場合、コードはどのように書いたらいいでしょうか？ 条件に合ったものを順に転記していくコードは書いたことがあるのですが、特定の範囲内ということや、転記する場所が指定されたりしていて、つまづいています。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
お礼
tom04様 今回もご対応頂き誠にありがとうございます。 非常に恥ずかしい話でありますが、 回答を拝見させてようやくわかりました。 lastlow2の部分は変数宣言してたですね この部分を普通の行の最終項目だと思っていました。 お恥ずかしい限りです。 再三の質問で丁寧な対応と 分かりやすいコメント含めて参考になると同時に 自分の力不足を実感するばかりです。 修正して頂いたコードで問題ありません！ 実データするのが少し時間かかるので 確認後、ベストアンサーに選ばせて頂きます。 前回の対応に引き続き 今回のご対応ありがとうございます！！
補足
返答、遅くなり申し訳ありません 無事、実際のデータで動きました。 2度の質問の丁寧な対応に感謝致します。 ほんとうにありがとうございます