• ベストアンサー
  • 困ってます

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 'この行まで

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

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

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

  • ベストアンサー
  • 回答No.5
  • mshr1962
  • ベストアンサー率39% (7416/18946)

No.3 mshr1962です。 >Sheet2のデーターが入っている、A1およびB1の指定がどの部分でされているのか教えて下さい。 ws1.Range("A1") = ws2.Cells(i, 1) ここのCells(行番号,列番号)で列番号は1がA列、2がB列と左から数えた数値に対応します。 A列をC列になら ws2.Cells(i, 1) → ws2.Cells(i, 3) とすれば変更完了です。慣れの問題ですが分かりにくいと思うなら ws1.Range("A1") = ws2.Range("A" & i) としても結果は同じです。

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

質問者からのお礼

mshr1962 様 何回も回答頂きお世話になりました。 判りやすい方法で回答頂き内容もよく理解できました。ありがとうございました。

関連するQ&A

  • 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

  • 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ヶ月前に書籍を購入して独自でできるか試したのですがダイレクトな情報が見つからず、基礎の部分だけはできたところです。 恐縮なのですがもし、できる方がいましたらぜひ教えて頂けませんでしょうか【黄色付け機能の所を】。 赤色付け機能(既に有り): 下記のようにSheet1のA列の数字を1つずつ検索して、sheet2にその数字があれば、sheet2のそのセル赤くする。 Sub 赤色付け() Set WS1 = Worksheets("Sheet1") Set WS2 = Worksheets("Sheet2") Dim RowPos As Integer Dim i As Integer For RowPos = 1 To 200 If WorksheetFunction.CountIf(Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), WS1.Cells(RowPos, 1)) > 0 Then i = WorksheetFunction.Match(WS1.Cells(RowPos, 1), Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), 0) WS2.Cells(i, 1).Interior.ColorIndex = 3 End If Next End Sub 【黄色付け機能:】 sheet1羅列を検索してsheet2に無い場合、逆にsheet1のその数字(検索してなかった数字)を黄色にもする ということは可能でしょうか。 下の場合、sheet1の123456と789123と456789が黄色になります。 そして、sheet2の123456と789123と456789以外が赤色になります。 ●sheet1のA列に下記のような数字が羅列(200行程)しています。 238062 238075 238096 238210 91518 238230 123456 789123 456789 ●sheet2のA列に下記のような数字が羅列しています。 91518 238062 238075 238096 238210 238230

その他の回答 (4)

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

No.2です! たびたびごめんなさい。 No.3さんへの補足を読ませていただいて・・・ No.2のコードでは余計に判りにくくなっていたみたいなので、もう一度コードをアップしてみます。 結果としては同じになりますが、今回のコードの内容の方が判りやすくてセル番地等の変更も簡単だと思います。 Sub test() Dim i As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("sheet1") Set ws2 = Worksheets("sheet2") For i = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row '←iは1~Sheet2A列の最終行まで ws1.Range("A1") = ws2.Range("A" & i) ws1.Range("B1") = ws2.Range("B" & i) ws1.PrintOut Next i End Sub こんなんでどうでしょうか? 何度も失礼しました。m(__)m

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

質問者からのお礼

tom04 様 この度は、本当にお世話になりました。 思うように動作してくれました。 ありがとうございました。

  • 回答No.3
  • mshr1962
  • ベストアンサー率39% (7416/18946)

単純にB1にA1同様にSheet2のB列の同行の値を表示でいいなら 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.Range("B1") = ws2.Cells(i, 2) '←Sheet1のB1セルに名前を表示 <<ここに追加行 ws1.PrintOut Next i End Sub 'この行まで

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

質問者からのお礼

mshr1962 様 早々の回答ありがとうございました。 思うようにうごきました。 もう少し教えて下さい。 BASICを勉強したことがあり、マクロのBASICに似た部分は判りますが、 Sheet2のデーターが入っている、A1およびB1の指定がどの部分でされているのか教えて下さい。 たとえば、Sheet2のA1がC1に変更、B1がD1に変更した場合どの部分がどのように変化しますか。 よろしくお願い致します。

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

こんばんは! 前回投稿した者です! 今日はちょっとヨッパです! 浄土真宗ですがクリスマスを少しやっていました。 ところで本題ですが Sheet2のA・B列には同じ行数のデータがあるわけですよね? そうであれば一例です。 Sub test() Dim i As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("sheet1") Set ws2 = Worksheets("sheet2") For i = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row With ws1.Range("A1") .Value = ws2.Cells(i, 1) .Offset(, 1) = ws2.Cells(i, 2) End With ws1.PrintOut Next i End Sub こんな感じではどうでしょうか? 参考になれば良いのですが・・・m(__)m

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

  • 回答No.1
  • okormazd
  • ベストアンサー率50% (1224/2411)

B列のデータ数がA列と同じかそれより少ない場合。 その他の場合は、どうなのか質問に示しておかないと。 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.Range("B1") = ws2.Cells(i, 2) '←Sheet1のB1セルに**を表示 ws1.PrintOut Next i End Sub 'この行まで

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

関連するQ&A

  • エクセル マクロの設定方法について

    差込印刷でSheet1に作成した名簿データにより、sheet2に作成しているデータへ差込印刷をしています。現在、次のようなマクロを組んで名簿の件数に合わせて、For = 2 To 500 Step 8を修正しながら、印刷しています。できたら、名簿の件数の増減に関係なく印刷できるようになればと考えています。始めたばかりのマクロ初心者です。よろしくご教授ください。お願いします。 Dim i As Long Dim ws1 As Worksheet, ws2 As Worksheet Set ws1 = sheets(″sheet1″) Set ws2 = sheets(″sheet2″) For i = 2 To 500 Step 8 ws2 .Range(″A1″).Value = ws1.Cells(i+1,2).Value ws2 .Range(″A7″).Value = ws1.Cells(i+2,2).Value ws2 .Range(″A13″).Value = ws1.Cells(i+3,2).Value ws2 .Range(″A19″).Value = ws1.Cells(i+4,2).Value ws2 .Range(″F1″).Value = ws1.Cells(i+5,2).Value ws2 .Range(″F7″).Value = ws1.Cells(i+6,2).Value ws2 .Range(″F13″).Value = ws1.Cells(i+7,2).Value ws2 .Range(″F19″).Value = ws1.Cells(i+8,2).Value DoEvents ws2.PrintOut Next End Subws2 .Range(″F1″).Value = ws1.Cells(i+5,2).Value ネット等で調べて、上記のようなマクロで作業してます。(マクロの設定方法が間違っているところがあると思いますが?)

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

    下記のようなプログラム組んでいます。 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に順次プラスする方法を教えて下さい。 よろしくお願いいたします。

  • エクセルVBAの記述の違い

    下記の2つともA1:B2の中身を削除するものですが、test1の書き方だと対象となるシートがアクティブではないとエラーになります。test2は問題なし。 Cellsの書き方のほうが変数を使う時に便利なのですが、なんでこんな違いがでてしまうのでしょうか? Sub test1() Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws1.Range(Cells(1, 1), Cells(2, 2)).ClearContents ws2.Range(Cells(1, 1), Cells(2, 2)).ClearContents End Sub Sub test2() Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws1.Range("a1:b2").ClearContents ws2.Range("a1:b2").ClearContents 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個以上の場合にどうようなマクロを記載すればよいのか アドバイスを頂けませんでしょうか。 よろしくお願いいたします。

  • エクセルでのマクロを使った参照

    教えてください。 シート1のB23:F73のデータをシート2に張りつけたいのですが、 その際にB列には連番で1~50の数字が入っており C、D列にはデータが有る場合とない場合があります。 データがある場合は必ず対で存在します。 貼り付けの際にC、D列にデータのある行のみ B、C、D列のデータを連続で並ばせたいのですが、 どのようにマクロを組んだらよろしいですか? 手元に資料もなく、困ってしまいました。 よろしくお願いします。 現在のマクロは以下の通りです Sub TEST4() Dim S1 As Worksheet, S2 As Worksheet Set S1 = Worksheets("SHEET1") Set S2 = Worksheets("SHEET1") S2.Range("A1:E51").Value = S1.Range("B23:F73").Value End Sub

  • エクセルマクロで教えてください

    Sub smp05_14_01() Dim 対象セル As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim 行 As Long, 列 As Long Dim i As Long Set ws1 = Worksheets("顧客") Set ws2 = Worksheets("売上") Set ws3 = Worksheets("顧客未登録") 行 = ws1.Range("A1").End(xlDown).Row - 1 列 = ws1.Range("A1").End(xlToRight).Column Set 対象セル = ws1.Cells(1, 列 + 2).Resize(2, 行) For i = 1 To 行 対象セル(1, i).Value = "顧客NO" 対象セル(2, i).Value = "<>" & ws1.Cells(i + 1, 1) Next ws2.Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=対象セル, _ CopyToRange:=ws3.Range("A1") 対象セル.Clear End Sub 上記のマクロは売上のシートに登録されている以外の顧客NOを顧客シートを参照して顧客未登録シートにコピーするのもですが添付したファイルの数だと上手くいくのですが、エクセルのヨコのセルの最大値の258を越えると上手くいきません。上記の処理で1000レコードを越えても売上シートに登録されている以外の顧客NOを参照して顧客未登録シートにコピーするマクロを教えてください。

  • エクセル マクロ修正

    シート1&#65374;5まであります。別に情報シートを作成しています それぞれ同じ原本から作成しています 全部のシートにA1&#65374;A10のセルに日付、B1&#65374;B10のセルに文字など入力がするところがあります 入力はA1から順番に入れていきます 例えば 保存ボタンを作成しておく シート1のA1に日付、B1に”文字”を入力し、保存ボタンをおす 情報シートに日付と内容が一致する情報がなければ、 情報シートのA列にシート名、B列に日付、C列に入力した内容が 空白のところに出力される ボタンのマクロがCommandButton1_Clickとしたら Private Sub CommandButton1_Click() 検索 End Sub 標準モジュールに Sub 検索() Dim c As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws1LastRow As Long Dim ws2LastRow As Long Set ws1 = Sheets("情報シート") Set ws2 = ActiveSheet If ws2.Range("A1").Value = "" Or ws2.Range("B1").Value = "" Then MsgBox "検索する日付もしくは語句が入力されていません。", vbCritical Exit Sub End If If ws1.Range("A1").Value = "" Then ws1LastRow = 0 Else ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row End If ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row For Each c In ws1.Range(ws1.Cells(1, "B"), ws1.Cells(Rows.Count, "B").End(xlUp)) If c.Value2 = ws2.Cells(ws2LastRow, "A").Value2 Then If c.Offset(0, 1).Value = ws2.Cells(ws2LastRow, "B").Value Then MsgBox "既にデータが存在します", vbInformation Exit Sub End If End If Next ws1.Cells(ws1LastRow + 1, "A").Value = ws2.Name ws1.Cells(ws1LastRow + 1, "B").Resize(1, 2).Value = ws2.Cells(ws2LastRow, "A").Resize(1, 2).Value MsgBox "データを追加しました", vbInformation Set ws1 = Nothing Set ws2 = Nothing End Sub これを教えて頂き作っていたのですが 別のシートを作成しこのプログラムを応用していたのですが うまく起動しないため再度投稿しました 今度のやつは固定でやろうと思っていていじったのですが 別の欄の文字が表示してしまった 結合セルB2:C4に日付を入れる 結合セルL2:L30に内容を入れるようにしたいのですが ここだけのセルを参照するようにしたいのです。 どうすればいいでしょうか? 試したことAをB2にかえ、BをL2にしたら変なことになりました・・・

  • エクセルの簡単なマクロ機能を追加したいのです

    既存のエクセルマクロ(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

  • EXCEL2007のマクロで2つのBOOKを比較

    EXCEL2007のマクロでABook,BBookと2つのBookのセルを比較して、数値が違うセルがある場合、BBookの方に新しいsheetを作成して、このsheetのA列に数値が違うセルの番地を、新しいsheetのA1、A2・・・と埋めていくマクロは作成する事は出来るでしょうか?因みに新しいsheetを作成するマクロまでは、出来ました。しかし、新しいsheetのA1、A2と書き込んでいくと、クリップボードの値がA1、A2、・・・入ってしまいます。 Dim ws1 As Object Dim ws2 As Object Dim ws3 As Object Dim co As Integer, ro As Integer, e As Integer Set ws1 = Workbooks(bookname1).Worksheets("明細") Set ws2 = Workbooks(bookname2).Worksheets("明細") Set ws3 = Workbooks(bookname2).Worksheets("エラーセル") If ws1.Cells(y, x).Value = ws2.Cells(y, x).Value Then Else ws3.Cells(e).Select ActiveCell.FormulaR1C1 = "A,e+1" End If マクロの骨格はこんな感じですけど、後は、Forループで回せば良いと考えております。 ActiveCell.FormulaR1C1 = "A,e+1"の部分が良く分かりません。 どの様にすれば、新たに作成したsheetのA1に数値が違うセルの番地例えばE5と入れる事が出来るのでしょうか、それもE5一つだけではなく沢山あります。G7とか・・・ どなたか、ご教授願います。宜しくお願い申し上げます。

  • 全部黄色になってしまいます

    下記のマクロを作成しました。 1.Sheet1のA列の数字を1つずつ検索して、sheet2にその数字があれば、sheet2のそのセル赤くする。 全部あればすべてのセルが赤くなり、無いところがあれば白いままというマクロ 2.sheet1羅列を検索してsheet2に無い場合、逆にsheet1のその数字(検索してなかった数字)を黄色にする。 困っていることは、何も数字の無いところが全部黄色になってしまいます。 sheet1の空白のところは処理せずにそのまま白くあって欲しいのですがどのようにすればいいでしょうか? ●sheet1のA列に下記のような数字が羅列(200行程)しています。 238062 238075 238096 238210 91518 238230 123456 789123 456789 ●sheet2のA列に下記のような数字が羅列しています。 91518 238062 238075 238096 238210 Sub 赤色付け() Set WS1 = Worksheets("Sheet1") Set WS2 = Worksheets("Sheet2") Dim RowPos As Integer Dim i As Integer For RowPos = 1 To 200 If WorksheetFunction.CountIf(Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), WS1.Cells(RowPos, 1)) > 0 Then i = WorksheetFunction.Match(WS1.Cells(RowPos, 1), Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), 0) WS2.Cells(i, 1).Interior.ColorIndex = 3 ELSE WS1.Cells(RowPos, 1).Interior.ColorIndex = 6 End If Next End Sub