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

このQ&Aのポイント
  • エクセルでのマクロを使って、シート1のB23:F73のデータをシート2に張りつける方法について教えてください。また、B列には連番で1~50の数字が入っており、C、D列にはデータの有無があります。データがある場合は必ず対で存在します。貼り付けの際にC、D列にデータのある行のみB、C、D列のデータを連続して並べたいのですが、どのようにマクロを組めばよいでしょうか。
  • エクセルでのマクロを使って、シート1のB23:F73のデータをシート2に張りつける方法を教えてください。B列には1から50までの連番が入っており、C、D列にはデータの有無があります。データがある場合は必ず対で存在します。貼り付けの際にC、D列にデータのある行のみ、B、C、D列のデータを連続して並べたいのですが、どのようにマクロを組めばよいでしょうか。
  • エクセルでのマクロを使って、シート1のB23:F73のデータをシート2に張りつける方法を教えてください。B列には連番の数字が入っており、C、D列にはデータの有無があります。データがある場合は必ず対で存在します。貼り付けの際にC、D列にデータのある行のみB、C、D列のデータを連続して並べたいのですが、どのようにマクロを組めばよいでしょうか。
回答を見る
  • ベストアンサー

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

教えてください。 シート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

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

  • ベストアンサー
回答No.1

これでよろしいでしょうか? Sub TEST4() Dim S1 As Worksheet, S2 As Worksheet Dim i As Integer 'SHEET1の行 Dim j As Integer 'SHEET2の行 Set S1 = Worksheets("SHEET1") Set S2 = Worksheets("SHEET2") j = 1 For i = 23 To 73 If S1.Range("C" & i) <> "" Then 'C列が空白でなかったら処理 S2.Range("A" & j & ":C" & j).Value = S1.Range("B" & i & ":D" & i).Value j = j + 1 End If Next End Sub

h_hideokun
質問者

お礼

ありがとうございました。 ばっちりです。 m(_ _;)m

関連するQ&A

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

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

  • 教えてマクロの記述?

    シート1に記述した内容をシート2に一覧形式で入力するマクロを以下の通り作成しました。 シート1に記述した内容を、別のブックのシートに一覧形式で入力していくマクロに変更するには どのようにマクロの記述をすれば宜しいのでしょうか?マクロの初心者にも分るようにご教授 いただければ助かります。よろしくお願いします。 Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1 .Range("B" & LastRow).Value = Worksheets("sheet1").Range("B1").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("B3").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("B5").Value .Range("E" & LastRow).Value = Worksheets("sheet1").Range("B7").Value .Range("F" & LastRow).Value = Worksheets("sheet1").Range("B9").Value .Range("G" & LastRow).Value = Worksheets("sheet1").Range("B11").Value End With End Sub

  • Excelのマクロについての質問です。マクロに関しては初心者です。

    Excelのマクロについての質問です。マクロに関しては初心者です。 温度を計測する実験をしています。sheet1に計測している数値が更新されていってどんどん書き込まれている状況です。 Dim fStop As Boolean 'グローバル変数を宣言 Private Sub Command1_Click() ' ' Macro1 Macro ' ' Dim iRows As Integer Dim sRows As String Dim i As Integer Dim tm As Single fStop = Fal For i = 1 To 500 Cells(1, 1) = i tm = Timer() + 5 Do DoEvents Loop While Timer() < tm ' 最終行の調査: iRows = Worksheets("Sheet1").UsedRange.Rows.Count ' 最終行をシート3にコピー Worksheets("Sheet1").Rows(iRows).Copy Destination:=Worksheets("Sheet4").Range("1:1") ' CH1 の最新データをシート3にコピー Worksheets("Sheet3").Range("B9").Value = Worksheets("Sheet1").Cells(iRows, 3).Value ' CH2 の最新データをシート3にコピー Worksheets("Sheet3").Range("C9").Value = Worksheets("Sheet1").Cells(iRows, 4).Value ' CH3 の最新データをシート3にコピー Worksheets("Sheet3").Range("D9").Value = Worksheets("Sheet1").Cells(iRows, 5).Value Next i End Sub Private Sub Command2_Click() fStop = True End Sub 上記のプログラムを作り、sheet1に書き込まれていってる数値の一番新しい数値のみをsheet3の特定のセルの場所に更新されていくように作りました。(コマンドボタン1で計測を開始、コマンドボタン2で計測終了) しかし計測する場所が増えるにつれて下記の部分のプログラムを増やさなければいけません。このプログラムを一まとめにして、指定されたsheet3のセルに書きこまれるようにしたいのですが、どのようなプログラムを加えればいいのでしょうか?Excelのバージョンは2003です。 ' CH1 の最新データをシート3にコピー Worksheets("Sheet3").Range("B9").Value = Worksheets("Sheet1").Cells(iRows, 3).Value ' CH2 の最新データをシート3にコピー Worksheets("Sheet3").Range("C9").Value = Worksheets("Sheet1").Cells(iRows, 4).Value ' CH3 の最新データをシート3にコピー Worksheets("Sheet3").Range("D9").Value = Worksheets("Sheet1").Cells(iRows, 5).Value

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

    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を参照して顧客未登録シートにコピーするマクロを教えてください。

  • エクセル マクロ IF関数について

    Sheet1にグループボックス内で、チェックボタンで項目を選択するとA1に記載されるように作成、マクロで入力ボタン作成しボタンをクリックするとSheet2に記載されるように作りました。しかし、項目が多いためSheet2を見るとABCDEFGなどの列に空白が目立ち使いづらいです。 そこでIF関数を使い何とか出来ないでしょうか? 例)SHEET1 B2に原因のグループボックスにカテゴリー(チェックボックスにて1)入力ミス、2)人、3)機械) B3に対応のグループボックスにカテゴリー(チェックボックスにて1)外注、2)修正、3)報告) と作り、それらがチェックされていたら、A1の列に表示され入力ボタンを押したら、Sheet2のAには原因、Bには対応と記載されるようにしたいです。その時Sheet1のA列に空白があれば、Sheet2の列に表示するようにしたいです。 実際のマクロ記入 Sub 入力() Dim LastRow As Long With Worksheets("Sheet2") LastRow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & LastRow).Value = Worksheets("Sheet1").Range("A6").Value .Range("B" & LastRow).Value = Worksheets("Sheet1").Range("A7").Value .Range("C" & LastRow).Value = Worksheets("Sheet1").Range("A8").Value .Range("D" & LastRow).Value = Worksheets("Sheet1").Range("A9").Value .Range("E" & LastRow).Value = Worksheets("Sheet1").Range("A10").Value .Range("F" & LastRow).Value = Worksheets("Sheet1").Range("A12").Value .Range("G" & LastRow).Value = Worksheets("Sheet1").Range("A13").Value .Range("H" & LastRow).Value = Worksheets("Sheet1").Range("A15").Value .Range("I" & LastRow).Value = Worksheets("Sheet1").Range("A16").Value .Range("J" & LastRow).Value = Worksheets("Sheet1").Range("A19").Value End With End Sub お願いします教えてください。

  • 他のブックでマクロを実行するには?

    以下のマクロを実行すると同一ブック内の他のシートに入力 されますが、これを他のブックのシートに入力されるように するには、具体的にどのようにすればいいのでしょうか? ご教授ください。 ---------------------------------------------------------------- Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1 .Range("B" & LastRow).Value = Worksheets("sheet1").Range("B1").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("B3").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("B5").Value .Range("E" & LastRow).Value = Worksheets("sheet1").Range("B7").Value .Range("F" & LastRow).Value = Worksheets("sheet1").Range("B9").Value .Range("G" & LastRow).Value = Worksheets("sheet1").Range("B11").Value End With End Sub

  • マクロ修正お願いします。

    以前質問してマクロを作成してもらった者です。 人事データ用に作っていただきました。 Sheet1   A   B   C 1 処遇 コード 名前.... 2 退社  3   あ   3 異動  4   か   4 入社  20   さ  Sheet2   A   B    C 1 コード 名前  データ1... 2  3   あ    3  4   か    4   Sub testsample() Dim Sh1 As Worksheet, Sh2 As Worksheet Dim r As Range, c As Range Set Sh1 = Worksheets("Sheet1") Set Sh2 = Worksheets("Sheet2") For Each c In Sh1.Range("A2", Sh1.Range("A65536").End(xlUp)) Select Case c.Value Case "入社"  c.Offset(, 1).Resize(, 255).Copy Sh2.Range("A2").End(xlDown).Offset(1)  'B列より、右端255行を、シート2のA列の最後尾の次にコピーする。 Case "異動"  Set r = Sh2.Columns(1).Find(c.Offset(, 1).Value, , xlValues, xlWhole)  If Not r Is Nothing Then c.Offset(, 1).Resize(, 255).Copy r  'コードを検索して、その見つかったものを上書き Case "退社"  Set r = Sh2.Columns(1).Find(c.Offset(, 1).Value, , xlValues, xlWhole)  If Not r Is Nothing Then r.EntireRow.Delete  'コードを検索して、その見つかったものを削除 End Select Next End Sub このマクロで一箇所どーしたらいいか分からない場所があります。 「異動」があった場合、sheet1には氏名コードと新しく配属される部署やtelなどのみを書き、メールアドや氏名など異動しても変わらないものは書き込みません。変更があった箇所のみ上書きし空白部分はそのままにしたいです。何度もすみませんがお願いします。

  • EXCELのマクロに関して

    vbaのマクロに関して質問があります。 マクロをどのように作ればよいでしょうか? マクロは以下のようになっています。sheet1以外(sheet2,sheet3など)に単語を入れて、sheet1でフラッシュ単語のようにするマクロです。これに付け加えたい内容があります。sheet1のセルにある値を入れれば、sheet1以外のシートのある特定の列をフラッシュ単語としてだしたいと考えています。シートと列を指定したいと考えています。 どのように付け足せばよいでしょうか? Sub sample() Dim i As Integer i = 1 Worksheets("sheet1").Activate Do Sheet1.Range("A1").Value = Sheet3.Range("b" & i).Value '1000で1秒,oで場所,sheet2の場所 Call Sleep(1000) DoEvents i = i + 1 Loop Until IsEmpty(Sheet3.Range("b" & i).Value) '1000で1秒,oで場所,sheet2の場所 End Sub

  • 抽出マクロが上手くいきません教えてください!

    数値と文字が混在しているB列に、 入力されている数値データの最後のみをを違う合計シートに抽出したいのですが、 上手くいきません。。 下記のマクロなのですが。。 分かる方教えてください お願いします ThisWOrkbook1 Private SubWorkbook_Open() Dim NO As Double Dim シート名 As String For l = 70 To 130 シート名 = Worksheet("goukei").Range("B" & l).Value Debug.Print シート名 Worksheets(シート名).Select Range("B30").End(xlUp).Offset(0).Select NO = Range("B30").End(xlUp).Offset(0).Value Debug.Print NO Worksheets("goukei").Select Range("C" & l) = NO Next End Sub

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

    エクセルのマクロについて エクセル2007を使用しています。もしよかったら教えて頂きたいと思っております。 現在利用しているメインシート(Sheet16で認識)のD5:I500の範囲内で1~31範囲の数字がランダムに入力されています。 この数字群の入ったセルをルール化しているセル背景色塗りを自動で処理したいためマクロを作成しております。 その仕様として、10個のシート(シート名:Aセット配色~Jセット配色)を作成して、各シートのB3:H7範囲に1~31までの数字が入っており、それぞれ数字に背景配色しています。Sheet16内と数字と条件によって該当する10個のシート内(シート名:Aセット配色~Jセット配色)の中から1つのシートとが一致したらそのセット配色シートのセルそのものの書式も運んでくれるルール設計になっています。 (※Sheet16の上記記載している範囲に直接入力及びコピーをして数字が一致したら、色が変わる仕組みになっています。) 更に、Sheet16内のJ3セルにA~J迄の半角英字を入力規制セットしており、例えばそのセルにCを入力すればCセット配色(シート名)、A入力であればAセット配色(シート名)を見に行き、該当処理をして行くという仕様になっております。 そのマクロ(※げNSheet16内に作成しています)が下記なのですが、拝見頂いて仕様がすぐお分かりになると思いますが、、 Private Sub Worksheet_Change(ByVal Target As Range) Dim v As Variant, c As Range, s As Range, myStr As String Dim rng As Range Set rng = Intersect(Target, Range("D5:I500")) If rng Is Nothing Then Exit Sub If Range("J3").Value = "" Then MsgBox "セット配色が未設定です。", vbCritical, "セットエラー " Exit Sub End If myStr = Range("J3").Value & "セット配色" Application.ScreenUpdating = False For Each c In rng.Cells For Each s In Worksheets(myStr).Range("B3:H7") v = c.Value If Not IsNumeric(v) Or v < 1 Or v > 31 Then Exit For c.Interior.ColorIndex = xlColorIndexNone c.Font.ColorIndex = xlColorIndexAutomatic If s.Value = v Then c.Interior.ColorIndex = s.Interior.ColorIndex c.Font.ColorIndex = s.Font.ColorIndex Exit For End If Next s Next c Application.ScreenUpdating = True Set rng = Nothing End Sub 今回の質問内容は、このマクロを少し仕様変更して、 C4:C500範囲でデータ書換えがあった場合にその瞬間、現行のJ3セルにその入力した英字と同じ値を表示させ次の処理に移行する方法にて上手くいかないかなと思っております。 上記のマクロを使用して追加組み込みをする前提で考えると、どういうコードを追加すれば実現出来ますでしょうか? どうかご伝授頂けますと幸いです。 よろしくお願い申しあげます。

専門家に質問してみよう