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

Excel 2007 マクロ 別シートの情報を反映する方法

Excel 2007 マクロ 別シートの情報を反映する方法 Sheet1とSheet2があります。 Sheet1のD列とSheet2のM列で同じ値があれば、 Sheet1のE列の値をSheet2のN列に反映するマクロを 作成しました。 下記が正しいと思っていたのですが、エラーメッセージは出ずに 値が反映されません。 マクロに問題点があればご指摘ください。 よろしくお願いいたします。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") For i = 2 To ws1.Cells(Rows.Count, "D").End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, "M").End(xlUp).Row If ws2.Cells(j, "M") = ws1.Cells(i, "D") Then ws2.Cells(j, "N") = ws1.Cells(i, "E") End If Next j Next i End Sub

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

  • 回答数6
  • 閲覧数2528
  • ありがとう数3

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

  • ベストアンサー
  • 回答No.5
  • tom04
  • ベストアンサー率49% (2537/5117)

No.2・4です! 前回のNo.4は無視してください。 If Val(ws2.Cells(j, 13)) = Val(ws1.Cells(i, 4)) Then としてみてください。 何度もごめんなさいね。m(__)m

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

質問者からのお礼

ご回答ありがとうございました。うまくいきました。大変助かりました。

関連するQ&A

  • Excel 2007 マクロのIF構文について

    Excel 2007 マクロのIF構文について Sheet1からSheet2にIF構文を使用して、 必要な情報を転記するマクロです。 下記マクロで実現できているのですが、IF構文が多く もっと効率的なマクロがあるのではないかと考えています。 IF構文が2つありますが、1つにまとめるマクロがありましたら お教えください。 Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '「Sheet1」シートを更新 Worksheets("Sheet1").Range("A1").ListObject.QueryTable.Refresh BackgroundQuery:=False '「Sheet1」シートから「Sheet2」シートに転記 For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, 13).End(xlUp).Row '「Sheet1」シートのL列から「Sheet2」シートのS列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "S") = ws1.Cells(i, "L") End If '「Sheet1」シートのG列から「Sheet2」シートのQ列に転記 If ws2.Cells(j, "M") = ws1.Cells(i, "A") Then ws2.Cells(j, "Q") = ws1.Cells(i, "G") End If Next j Next i End Sub

  • シート1の氏名をシート2に反映

    sheet1の氏名をsheet2の日付、記号(A,B,C)にマッチした位置に入力させたいのですが下記コードで他で試したのですがうまくいきません。どなたかコードが解る方よろしくお願いします。 Sub 入力() Dim i As Long, j As Long, k As Long, L As Long Dim wS1 As Worksheet, wS2 As Worksheet Set wS1 = Worksheets("Sheet1") Set wS2 = Worksheets("Sheet2") i = wS2.Range(wS2.Cells(6, 1), wS2.Cells(8, 1)) j = wS2.Cells(3, Columns.Count).End(xlToLeft).Column Range(wS2.Cells(3, 2), wS2.Cells(i, j)).ClearContents On Error Resume Next For i = 2 To wS1.Cells(Rows.Count, 4).End(xlUp).Row If WorksheetFunction.CountA(wS1.Rows(i)) > 1 Then For j = 2 To wS1.Cells(i, Columns.Count).End(xlToLeft).Column If wS1.Cells(i, j) <> "" Then k = WorksheetFunction.Match(wS1.Cells(i, 4), wS2.Range(wS2.Cells(6, 1), wS2.Cells(8, 1)), False) L = WorksheetFunction.Match(wS1.Cells(5, j), wS2.Rows(3), False) wS2.Cells(k, L) = wS1.Cells(i, j) End If Next j End If Next i End Sub

  • Excel マクロ 重複チェックについて

    Excel マクロ 重複チェックについて Sheet3のA列とB列に製品番号が入っています。 A列とB列を比較して、A列と同じ番号がB列に2個以上ある場合のみ C列にフラグ「1]を入れたいです。 Sub RetsuCheck() Dim i As Long Dim ws1 As Worksheet Set ws1 = Worksheets("Sheet3") '「Sheet3」シートでA列とB列の重複をチェック。 For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row If ws1.Cells(i, "A") = ws1.Cells(i, "B") Then ws1.Cells(i, "C") = 1 End If Next i End Sub 1個の場合には上記マクロで解決するのですが、 2個以上の場合にどうようなマクロを記載すればよいのか アドバイスを頂けませんでしょうか。 よろしくお願いいたします。

その他の回答 (5)

  • 回答No.6

> 数字が文字列になっているや数値になっている等の理由で > 同じ数字でも異なるものとして認識されることはございますか。 はい、それは当然です。 数値の数字と文字列の数字は異なるものですから。 それを同じとしたいならVal関数を使うか*1をするかですね。

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

質問者からのお礼

ご回答ありがとうございました。

  • 回答No.4
  • tom04
  • ベストアンサー率49% (2537/5117)

No.2です! 補足を読ませてもらいました。 文字列の数字と数値が混在しているわけですかね? もしそうであって、数字の文字列を数値として扱いたい場合は If ws2.Cells(j, 13).Value = ws1.Cells(i, 4).Value Then としてみてはどうでしょう? 本来であればこの 「.Vlue」は省かずに入力する習慣をつけた方が良いのかもしれません。 外していたらごめんなさいね。m(__)m

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

  • 回答No.3

hyogara777さんの提示したコードは、直すところといったら Dim i As Long, j As Long Dim ws1 As Worksheet, ws2 As Worksheet と書いた方がいいというくらいで、お書きになった > Sheet1のD列とSheet2のM列で同じ値があれば、 > Sheet1のE列の値をSheet2のN列に反映する を正しく表現しています。 そのままで動くはずです。 そうならないとしたら前提が違っているのでは?

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

質問者からの補足

ご回答ありがとうございます。 すみません。ご回答頂きました3人の方に同じ補足の質問をさせて頂きます。 If ws2.Cells(j, 13) = ws1.Cells(i, 4) Then それぞれのセルには3桁の数字が入っています。 それぞれの数字を比較する場合、 数字が文字列になっているや数値になっている等の理由で 同じ数字でも異なるものとして認識されることはございますか。

  • 回答No.2
  • tom04
  • ベストアンサー率49% (2537/5117)

こんにちは! すでに回答は出ていますので、参考程度で、 列番号も数値にしてみてはどうでしょうか? こんな感じですかね? Sub Rist() Dim i, j As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") For i = 2 To ws1.Cells(Rows.Count, 4).End(xlUp).Row For j = 2 To ws2.Cells(Rows.Count, 13).End(xlUp).Row If ws2.Cells(j, 13) = ws1.Cells(i, 4) Then ws2.Cells(j, 14) = ws1.Cells(i, 5) End If Next j Next i End Sub m(__)m

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

質問者からの補足

ご回答ありがとうございます。 すみません。ご回答頂きました3人の方に同じ補足の質問をさせて頂きます。 If ws2.Cells(j, 13) = ws1.Cells(i, 4) Then それぞれのセルには3桁の数字が入っています。 それぞれの数字を比較する場合、 数字が文字列になっているや数値になっている等の理由で 同じ数字でも異なるものとして認識されることはございますか。

  • 回答No.1
  • KURUMITO
  • ベストアンサー率42% (1835/4283)

次のように変えてみてはいかがでしょう。 For i = 2 To ws1.Range("D65536").End(xlUp).Row For j = 2 To ws2.Range("M65536").End(xlUp).Row

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

質問者からの補足

ご回答ありがとうございます。 すみません。ご回答頂きました3人の方に同じ補足の質問をさせて頂きます。 If ws2.Cells(j, 13) = ws1.Cells(i, 4) Then それぞれのセルには3桁の数字が入っています。 それぞれの数字を比較する場合、 数字が文字列になっているや数値になっている等の理由で 同じ数字でも異なるものとして認識されることはございますか。

関連するQ&A

  • Excelマクロのことで教えて下さい

    初歩的なことですみません。 E列の値をF列に値を入れるために下記のマクロを組みました。 Sub test() Worksheets("Sheet1").Select Dim i As Long For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row Range("F2").Value = "=E2/1024/1024" Cells(i, 6).FillDown Range(Cells(2, 6), Cells(i, 6)).Copy Range("F2").PasteSpecial Paste:=xlValues Next i End Sub ところがF列に「値のみを貼り付け」をした時に、途中から同じ値のみがコピーされてしまい困っています。 (画像参照) うまく貼り付けることができるマクロをお教え下さい。 よろしくお願いいたします。

  • 置換のマクロ

    すみません、基礎的なことかもしれませんが、 調べてもわかりませんでした… 下記マクロで、今はwS1のA列に置換したい文字があった場合 置換をしてくれますが、 A列だけではなく、wS1のシート全体を指定する為にはどのように書き換えればいいでしょうか…? Replace(wS1.Cells(i, "A"), wS2.Cells(k, "A") の wS1.Cells(i, "A") を Aではなく、シート全体の指定に変えたいのです。。 Sub 置換() Dim i As Long, k As Long, wS1 As Worksheet, wS2 As Worksheet Set wS1 = ActiveSheet Set wS2 = Worksheets("置換") Application.ScreenUpdating = False For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row For k = 1 To wS2.Cells(Rows.Count, "A").End(xlUp).Row If InStr(wS1.Cells(i, "A"), wS2.Cells(k, "A")) > 0 Then wS1.Cells(i, "A") = Replace(wS1.Cells(i, "A"), wS2.Cells(k, "A"), wS2.Cells(k, "B")) End If Next k Next i Application.ScreenUpdating = True End Sub 過去の質問↓の回答にあったマクロから、少し変えて使わせていただいています。 http://okwave.jp/qa/q8293972.html

  • Excel マクロの一部改造の方法を教えて下さい。

    先日、tom04さんから下記のマクロを教えていただきました。 sheet1のセルA1にsheet2のセルA1からA??までの項目を順次入れ、sheet1を印刷するものです。 これに、追加でsheet1のセルB1にも項目を追加したいのです、データーはsheet2のB1から入れておくこととします。 下記のマクロを教えて下さった、tom04さんの目にとまれば幸いですが、内容を理解して頂いた方ならどなたでも回答頂ければ幸いです。よろしくお願い致します。 改造して頂きたいマクロは下記です。 Sub test() 'この行から Dim i As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("sheet1") '←Sheet名は適宜変更してください Set ws2 = Worksheets("sheet2") '←こちらのSheet名も適宜変更 For i = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row ws1.Range("A1") = ws2.Cells(i, 1) '←Sheet1のA1セルに名前を表示 ws1.PrintOut Next i End Sub 'この行まで

  • エクセルで入力シートから別シートに転記・蓄積について

    エクセルVBAで入力シートのA1:D5(5行)の範囲を別シート(DBシート)の転記・蓄積させる方法を教えてください。また、入力データがA1:A5(1行)のときもあれば、A1:D5(5行)の場合ですが・・・ Sub test01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("入力") Set ws2 = Sheets("DB") x = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "A").End(xlUp).Row ws1.Cells(1, "A").Resize(y, 4).Copy ws2.Cells(x, "A") End Sub の場合、数式等、入力値すべてが転記となってしまいます。 値だけ転記する方法はありませんか? 宜しくお願いいたします。

  • 完全一致したら複数のセルを順に代入するマクロは?

    エクセルのSheet1のA列にある文字列と、Sheet2にあるA列にある文字列と完全一致したら、前者のセルの右右右隣セル(一致したセルから数えて4番目のセル)から3番目までのセルに、後者のセルの右隣セル(一致したセルから数えて2番目のセル)から3番目までの文字列を順に代入するマクロをお教えください。つまり代入開始セルをSheet1のD列にしたいのです。(実は任意の列からにしたのですが…)。単純にvlookup関数を使えばいいのですが、VBAで行いたいのです。 一致したセルの右隣のセルから順に代入するマクロは以下で解決済みです。以下のマクロを編集して実行したいのですが、どこをいじったらよいかわかりません。 なお、代入したいセルを右の任意のセルまで引き延ばしたい場合、以下のコード任意Loop Until Coln1 = 4の右辺の数字を変更すればよいことまではわかっています。どうぞ、よろしくお願い申し上げます。 ---------------- Sub 試験() Dim Row1 As Integer Dim Coln1 As Integer Dim Row2 As Integer Dim Coln2 As Integer Set WS1 = Worksheets("Sheet1") Set WS2 = Worksheets("Sheet2") Coln1 = 1 Coln2 = 1 For Row1 = 1 To WS1.Cells(Rows.Count, 1).End(xlUp).Row For Row2 = 1 To WS2.Cells(Rows.Count, 1).End(xlUp).Row If WS2.Cells(Row2, 1) = WS1.Cells(Row1, 1) Then Do Coln1 = Coln1 + 1 Coln2 = Coln2 + 1 WS1.Cells(Row1, Coln1) = WS2.Cells(Row2, Coln2) Loop Until Coln1 = 4 Coln1 = 1 Coln2 = 1 End If Next Row2 Next Row1 End Sub

  • マクロを使って・・・

    シート1に入力したデータをシート2にコピーするいうマクロを作りました。 シート2にコピーはできるのですが 例えば、そのデータを消して再度新しいデータを入れていきたいと思い エクセル左上のシート全体を選択して「Delete」を押すと 会社のエクセル(2003?)は中断モードがどーのこーのとエラー画面が出て マクロが黄色になって、前に進めません。 やり方が決まっているのでしょうか? コピーした行全体を選択して右クリック「削除」とすると エラー画面が出ません。 やり方など決まっているのでしょうか? ↓がんばって作ったマクロです Sub 正方形長方形4_Click() Call macro01 Call macro02 End Sub Sub macro01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet2") x = ws2.Cells(Rows.Count, "b").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "b").End(xlUp).Row ws1.Cells(21, "b").Resize(y, 9).Copy ws2.Cells(x, "B").PasteSpecial Paste:=xlPasteValues  ←この行が黄色になります Application.CutCopyMode = False End Sub Sub macro02() Worksheets("Sheet1").PrintOut End Sub

  • 複数のエクセルシートをまとめるマクロ

    下は複数のエクセルファイルを一つにするマクロですが、100万件を超えるためcsvで保存するようにするにはどこを変更したらよいでしょうか。 よろしくお願いします。 Sub Sample() Dim t As Single Dim strPath As String Dim strFileName As String Dim WB1 As Workbook Dim WS1 As Worksheet Dim WS2 As Worksheet Dim lngRowCount As Long 'A列に値が入っているデータ数 t = Timer 'まとめたいシート Set WS2 = ThisWorkbook.Worksheets(1) strPath = ThisWorkbook.Path strFileName = Dir(strPath & "\*.xls*") Do While strFileName <> "" If strFileName <> ThisWorkbook.Name Then Set WB1 = Workbooks.Open(strPath & "\" & strFileName) Set WS1 = WB1.Worksheets(1) With WS1.Range("A1") lngRowCount = .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp).Row - .Row If lngRowCount >= 1 Then With .Resize(lngRowCount, 14).Offset(1) .Copy WS2.Range("A" & WS2.Rows.Count).End(xlUp).Offset(1) End With End If End With WB1.Close False End If strFileName = Dir Loop MsgBox "まとめ処理をしました。処理時間 " & Format((Timer - t) / 60 / 60 / 24, "h:mm:ss") End Sub

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

    下記のようなプログラム組んでいます。 Sub 張付() Sheets("一覧表").Select Dim i As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("一覧表") Set ws2 = Worksheets("データー") For i = 5 To ws2.Cells(Rows.Count, 1).End(xlUp).Row ws1.Range("B5") = ws2.Cells(i, 2)    'セルB5に氏名を入力 ws1.Range("C5") = ws2.Cells(i, 3)    'セルC5に年齢を入力 ws1.Range("D5") = ws2.Cells(i, 4)    'セルD5に電話番号を入力 この後、 ws1.Range("B5")のB5をB6にまた、C5はC6に改行してそれぞれデーターを移していきたい のですが、B5をB6に順次プラスする方法を教えて下さい。 よろしくお願いいたします。

  • Vlookupマクロにつきまして

    初心者で、 エクセルのマクロにて、下記の処理を行おうとしているのですが、 上手く行きません。 どなたかお助けください! B3=Vlookup(A3,Sheet2!A:F,3,False) B4 A4 B5 A5 とA列に値がある限りカウントアップしていきます。 以下の通り考えてみたのですが、動きません。 Sub vlookup() Dim i As Long For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row Cells(i, "B") = Application.WorksheetFunction.VLookup(Range(Cells(i, "A")), Worksheets("Sheet2").Range("A:F"), 3, False) Next End Sub すみません、宜しくお願いします。

  • excel2003入力したデータを別シートにコピー

    会社でエクセル2003を使っています。 ド素人で、専門用語が全く分からないのでお許しください。 ひな形に入力したデータを その都度、別シートにリストとして保存したいのです。 ネットで調べたところマクロを使うようで Sub 正方形長方形4_Click() Call macro01 Call macro02 End Sub Sub macro01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet2") x = ws2.Cells(Rows.Count, "b").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "b").End(xlUp).Row ws1.Cells(21, "b").Resize(y, 9).Copy ws2.Cells(x, "B").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub Sub macro02() Worksheets("Sheet1").PrintOut End Sub いろいろ知らべみてこのようなマクロを作りました。 家のエクセル2010では順番に入力行のその下にデータリストが増えていくのですが 会社の2003だと2行空いてしまうのです。 上記にマクロは家で作って会社ではそのマクロを入力する形です。 マクロの意味が全く分からず、どこを修正すればいいのかもわかりません。 お力をお貸しください。 よろしくお願いいたします。