excelマクロ 実行時の挙動について

前へ 次へ
このQ&Aのポイント
  • Excelマクロを実行した際に、特定の行に計算式がコピーされる理由と、その修正方法について教えてください。
  • 実行したマクロでは、Sheets("提供データ")のD列の7327行目が空白のにもかかわらず、Sheets("jyoken")のA列の7326行目に計算式がコピーされます。
  • また、Sheets("jyoken")のA列の2行目には"=提供データ!D3"という計算式が入っています。
回答を見る
  • ベストアンサー

excelマクロについて

下記のマクロを実行したときに、Sheets("提供データ")のＤ列の7327行目はブランクなのに、Sheets("jyoken")のa列の7326行目に計算式がコーピされるのはなぜでしょうか。 ちなみにSheets("jyoken")のa列の2行目に=提供データ!D3という計算式 が入っています。 Sheets("jyoken")のa列の7326行目には計算式がコーピしないようにするにはどこを修正すればよいのでしょうか教えてください。 Sub 式複写() Dim gyo, burank ActiveWorkbook.PrecisionAsDisplayed = False Sheets("提供データ").Select Range("a2").Select gyo = 2 burank = "" Do gyo = gyo + 1 burank = Worksheets("提供データ").Cells(gyo, 4).Text Loop While burank <> "" ' Sheets("jyoken").Select Range("A2").Select Selection.Copy Range(Cells(3, 1), Cells(gyo - 1, 1)).Select '複写先 ActiveSheet.Paste End Sub

noname#72697
noname#72697

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

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

ANo.3さんへ sheet("提供データ")以外がカレントのとき、エラーになるので、 Sub 複写() Dim d As Integer ActiveWorkbook.PrecisionAsDisplayed = False d = Sheets("提供データ").Range("D65536").End(xlUp).Row Sheets("提供データ").Range(Sheets("提供データ").Cells(2, "D"), Sheets("提供データ").Cells(d, "D")).Copy Sheets("jyouken").Range("A2") End Sub または Sub 複写() Dim d As Integer ActiveWorkbook.PrecisionAsDisplayed = False Sheets("提供データ").Select d = Range("D65536").End(xlUp).Row Range(Cells(2, "D"), Cells(d, 4)).Copy Sheets("jyouken").Range("A2") End Sub とかにした方が良いと思います。

その他の回答 (3)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

質問ではコードを長々と読まされたが、 Sub 複写() Dim d ActiveWorkbook.PrecisionAsDisplayed = False d = Worksheets("提供データ").Range("D65536").End(xlUp).Row Worksheets("提供データ").Range(Cells(2, "D"), Cells(d, "D")).Copy Sheets("jyouken").Range("A2") End Sub これでたぶん実質同じではないの。 質問のエラー追及も必要なくなるのでは。 また内容は（プロシジュアー名の）式複写ではなく、式も値も書式も貼り付けますよ。

回答No.2

提供データが1個の場合があるなら問題が起こるので、ifで囲った方がいいかも・・・ gyo>4の意味は、Sheets("提供データ")の最初のブランクがD4の場合、つまりgyo=4の場合は複写する必要が無いと言う意味です。 If gyo > 4 Then Sheets("jyoken").Select Range("A2").Select Selection.Copy Range(Cells(3, 1), Cells(gyo - 2, 1)).Select '複写先 ActiveSheet.Paste End If p.s. 提供データが無い場合（Sheets("提供データ")のD3がブランクの場合）は無いんですよね？

  • toshi_2000
  • ベストアンサー率30% (306/1002)
回答No.1

Do Loopを抜けたときにgyoの値は、7327になっています。したがって7327-1の7326行目までコピーされます。 7325行目までコピーするのなら、 Range(Cells(3, 1), Cells(gyo - 2, 1)).Select '複写先 これでいいかと思います。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • ＥＸＣＥＬマクロについて

    条件　シート名提供データＥ列の3行目からデータが入っています。 　　　ブランク以外のデータをコピーしてシート名WorkのＣ列の2行目から貼り付けたいので下記のマクロを書いていますがおかしい所 はないのでしょうか。教えてください。 いまいちCellsの使い方がわかりません。 出来たら下記の意味を教えてください。 brank = Worksheets("提供データ").Cells(gyo, 5).Text Range(Cells(3, 5), Cells(gyo, 5)).Select Sub 貼付() Dim gyo, brank Sheets("提供データ").Select Range("e3").Select gyo = 2 Do gyo = gyo + 1 brank = Worksheets("提供データ").Cells(gyo, 5).Text Loop While brank <> "" Range(Cells(3, 5), Cells(gyo, 5)).Select Selection.Copy Sheets("work").Select Range("c2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

  • エクセル2003マクロの再編集

    Sub test() Dim 行1 As Long, 最終行 As Long, 行2 As Long Sheets("Sheet2").Cells.ClearContents Sheets("Sheet1").Activate 最終行 = Range("C65536").End(xlUp).Row 行2 = 1 For 行1 = 1 To 最終行 Sheets("Sheet2").Cells(行2, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Cells(行2, 3).Value = Abs(Sheets("Sheet2").Cells(行2, 3).Value) If Range("A" & 行1).Value = "BBBB1" Then Sheets("Sheet2").Range("A" & 行2) = Range("A" & 行1) & "-1" Sheets("Sheet2").Cells(行2 + 1, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Range("A" & 行2 + 1) = Range("A" & 行1) & "-2" 行2 = 行2 + 1 End If If Range("A" & 行1) = "" Then 行2 = 行2 - 1 Sheets("Sheet2").Range("C" & 行2) = Sheets("Sheet2").Range("C" & 行2) + Range("C" & 行1) End If 行2 = 行2 + 1 Next 行1 End Sub を編集したいのですが全然図りません ご指導お願いします 元データ AAAA5　9601　　950 BBBB1　9660　　150 ASAS9　9654　　-50 AXCW5　9603　　1375 以下の用にマクロで変換する用に出来たのですが 【1】 BBBB1だけではなくAAAA5も対処になったときの 追加方法です 元データは一切変更が出来ません ※フォントの変更も不可です 【2】 元データと変換後データがSheet1からSheet2になっていますが Sheet1の元は範囲はA1～C400で変換後をSheet1E1～G400にしたいのです AAAA5　9601　　950　 BBBB1-1　9660　　150　 BBBB1-2　9660　　150 ASAS9　9654　　50 AXCW5　9603　　1375

  • エクセル2003マクロの機能追加

    Sub test() Dim 行1 As Long, 最終行 As Long, 行2 As Long Sheets("Sheet2").Cells.ClearContents Sheets("Sheet1").Activate 最終行 = Range("C65536").End(xlUp).Row 行2 = 1 For 行1 = 1 To 最終行 Sheets("Sheet2").Cells(行2, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value If Range("A" & 行1).Font.Bold Then Sheets("Sheet2").Range("A" & 行2) = Range("A" & 行1) & "-1" Sheets("Sheet2").Cells(行2 + 1, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Range("A" & 行2 + 1) = Range("A" & 行1) & "-2" 行2 = 行2 + 1 End If If Range("A" & 行1) = "" Then 行2 = 行2 - 1 Sheets("Sheet2").Range("C" & 行2) = Sheets("Sheet2").Range("C" & 行2) + Range("C" & 行1) End If 行2 = 行2 + 1 Next 行1 End Sub 元データ AAAA5　9601　　950 BBBB1　9660　　150 ASAS9　9654　　-50 AXCW5　9603　　1375 以下の用にマクロで変換する機能を追加したいのです AAAA5　9601　　950 BBBB1-1　9660　　150 BBBB1-2　9660　　150 ASAS9　9654　　50 AXCW5　9603　　1375 宜しくおねがいします。

  • エクセルマクロ：範囲の選択

    マクロで範囲を指定したいのですが、 dataと名づけたシートA1に例えば8という値、A2に20という値があります。 この数字は他のセルから参照する計算式になっていて再計算をするたびに変わります。 この時、C8:E20の範囲を指定したいのですが、やみくもに Dim c As Integer c = 3 'C列 Range(Cells(Sheets("data").Range("A1").Value, c), Cells(Sheets("data").Range("A2").Value, c + 2)).Select Selection.Copy などと書いてみたのですが、うまくいきません。 どのように記述すればよいか、教えてください、宜しくお願いいたします。

  • EXCELでマクロを使って、小計、合計の出し方

    １．部の中にそれぞれ、営業１課、営業２課、…があり、社員と売上金額が表示されている下記のようなデータがあります。 部、課、社員の数は、実際はもっとたくさんあり、それぞれの件数は、毎月変化します。 マクロを使って、課毎計、部毎計、総合計を出す方法を教えて下さい。 試しに作りましたら、下記のような結果になり、うまくいきません。 元データ 部 課 社員 金額 A 営業１課 a 10 A 営業１課 b 20 A 営業１課 c 30 A 営業２課 d 40 A 営業２課 e 50 A 営業２課 f 60 Ｂ 営業１課 ｇ 70 Ｂ 営業１課 h 80 Ｂ 営業１課 I 90 Ｂ 営業２課 j 100 Ｂ 営業２課 k 110 Ｂ 営業２課 l 120 実行結果 　 　 　　　　　 × 　 正解 部 課 社員 金額 　 金額 A 営業１課 a 10 　 10 A 営業１課 b 20 　 20 A 営業１課 c 30 　 30 　 営業１課　計　 60 　 60 A 営業２課 d 40 　 40 A 営業２課 e 50 　 50 A 営業２課 f 60 　 60 　 営業２課　計 210 　 150 A　合計 　 　 110 　 210 Ｂ 営業１課 ｇ 70 　 70 Ｂ 営業１課 h 80 　 80 Ｂ 営業１課 I 90 　 90 　 営業１課　計 240 　 240 Ｂ 営業２課 j 100 　 100 Ｂ 営業２課 k 110 　 110 Ｂ 営業２課 l 120 　 120 　 営業２課　計 570 　 330 Ｂ　合計 　 　 230 　 570 総合計 　 　 780 　 780 Sub 合計計算() Sheets("元").Select Sheets("元").Copy Before:=Sheets(2) Dim GYO1 As Long '部 グループの先頭行 Dim GYO2 As Long '部 グループの最終行 Dim GYO3 As Long '課グループの先頭行 Dim GYO4 As Long '課グループの最終行 Dim GYO As Long '小計、合計行 Dim strFORMULA As String GYO = 2 '空白でない間、次の作業を繰り返す Do While Cells(GYO, 1).Value <> "" GYO1 = GYO GYO = GYO + 1 '部が同じ間、次の作業を繰り返す Do While Cells(GYO, 1).Value = Cells(GYO1, 1).Value GYO = GYO + 1 '課が同じ間、次の作業を繰り返す GYO3 = GYO Do While Cells(GYO, 2).Value = Cells(GYO3, 2).Value GYO = GYO + 1 Loop '課計 GYO2 = GYO - 1 Rows(GYO).Insert Cells(GYO, 2).Value = Cells(GYO3, 2).Value & "　計" Cells(GYO, 4).FormulaR1C1 = "=SUBTOTAL(9,R" & GYO1 & "C:R" & GYO2 & "C)" GYO = GYO + 1 Loop '部計 GYO4 = GYO - 1 Rows(GYO).Insert Cells(GYO, 1).Value = Cells(GYO1, 1).Value & "　合計" Cells(GYO, 4).FormulaR1C1 = "=SUBTOTAL(9,R" & GYO3 & "C:R" & GYO4 & "C)" GYO = GYO + 1 Loop ' 総合計 Cells(GYO, 1).Value = "総合計" Cells(GYO, 4).FormulaR1C1 = "=SUBTOTAL(9,R1C:R" & GYO2 & "C)" Range("A1").Select End Sub ２．尚、この質問のように表形式のデータを間隔をあけて原稿を作成しても確認画面になると、間隔が詰まります。間隔が詰まらない方法も教えて下さい。

  • 【エクセル VBA マクロ】

    シートAの日付を確認してデータをコピーし、シートBの該当する日付の列に売り上げを貼り付けるというマクロを組みたいです。 他の方達のを参考にしながら作成しましたが、実行をすると「エラー1004」 Matcheプロパティが見つからないというエラーが出ます。 どなたか原因と対策を教えてください。 Sub() Sheets("シートA"）.Select Range("J3:J10000").Select ※売上データ Selection.Copy 検査値 = Range("R2").Value ※日付データ Sheets("シートB").Select Set 検索範囲 = Range("J4:AN4") ※日付データ 列 = Application.WorksheetFunction.Match(検査値, 検索範囲, 0) Cells("4, 9" + 列).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,SkipBlanks:False, Transpose:=True End Sub

  • マクロLOOP文を別方法で高速化

    シート２のボタンをクリックすると Sub　編集が起動します。 Sub　編集にはＣａｌｌで2種類のプロシージャーを 呼び出します。 シート１には約20,000行のデータがあります。 処理に約2分かかっています。 もう少し高速にする方法は 有りますでしょうか？ プロシージャーは分けておきたいです。 シートに式は入れたくありません。 Sub　編集にはCall文でさらに別のプロシージャーを5個呼び出しますが Ｆ８キーで確認すると、それらは秒速で処理されてました。 一番時間がかかっているのがこの部分なので この部分を対策したいです。 よろしくお願いします。 Sub 編集() 　Call 検索キー 　Call 日付02 　　Sheets("シート１").Select 　　Range("R1") = "キー" 　　Range("S1") = "日付" 　　Columns("B:B").Select 　　Selection.Delete Shift:=xlToLeft 　　Columns("F:F").Select 　　Selection.Delete Shift:=xlToLeft 　　Columns("H:O").Select 　　Selection.Delete Shift:=xlToLeft 　　Range("A1").Select 　　MsgBox "編集終了" 　　Sheets("シート２").Select End Sub 　　Sub 検索キー() 　　　'2010年11月17日 　　　'R列にC,D,E列を連結させた値を転記 　　　　Sheets("シート１").Select 　　　　行 = 2 　　　　Do 　　　　If Cells(行, 1).Value = "" Then Exit Do 　　　　Cells(行, 18).Value = Cells(行, 3) & Cells(行, 4) & Cells(行, 5) 　　　　行 = 行 + 1 　　　　Loop 　　　End Sub 　　　Sub 日付02() 　　　　'2010年11月17日 　　　　'A列の値、半角数字8桁を下4桁で 　　　　'2桁目に/を入れてS列に転記（セルの値もセル表示も） 　　　　'例：A列20101117　S列　11/17 　　　　'セルの値が2010/11/17でセルの表示が11/27は不可 　　　　　Sheets("シート１").Select 　　　　　For 行 = 2 To Cells(Rows.Count, "A").End(xlUp).Row 　　　　　With Cells(行, 19) 　　　　　.NumberFormat = "@" 　　　　　.Value = Format(Cells(行, 1), "!@@/@@") 　　　　　End With 　　　　　Next 　　　End Sub

  • エクセルのマクロで各Sheetのデータを複数コピー&ペーストしたいです

    エクセルのマクロで各Sheetのデータを複数コピー&ペーストしたいです １つのエクセルファイルの中に複数のSheetがあります。 各Sheetの4行目以降（5行目から）にデータのあるA列～O列をコピーしていって、 挿入-ワークシート（Sheet1という名前で構わない）に全てを順番にコピーしていきたいです。 ”新しいマクロの記録”で下記のように作成したのですが、 　・5行目からデータのあるA列～O列をコピーしていく　 　・存在する全てのSheetから上記の作業をする というマクロの書き方が分かりません。 恐れ入りますがお時間ある方で上記の内容をご理解頂ける方がいましたらアドバイス頂ければ非常に助かります。 Sub Macro1() Sheets.Add Sheets("ER10(zy)").Select Rows("5:8").Select Selection.Copy Sheets("Sheet1").Select ActiveSheet.Paste Sheets("ER10(cx)").Select Rows("5:9").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("A5").Select ActiveSheet.Paste Sheets("ER10(zht)").Select Rows("5:13").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("A10").Select ActiveSheet.Paste End Sub

  • エクセルのマクロで各Sheetのデータを複数コピー&ペーストしたいです

    エクセルのマクロで各Sheetのデータを複数コピー&ペーストしたいです １つのエクセルファイルの中に複数のSheetがあります。 各Sheetの4行目以降（5行目から）にデータのあるA列～O列をコピーしていって、 挿入-ワークシート（Sheet1という名前で構わない）に全てを順番にコピーしていきたいです。 ”新しいマクロの記録”で下記のように作成したのですが、 　・5行目からデータのあるA列～O列をコピーしていく　 　・存在する全てのSheetから上記の作業をする というマクロの書き方が分かりません。 恐れ入りますがお時間ある方で上記の内容をご理解頂ける方がいましたらアドバイス頂ければ非常に助かります。 Sub Macro1() Sheets.Add Sheets("ER10(zy)").Select Rows("5:8").Select Selection.Copy Sheets("Sheet1").Select ActiveSheet.Paste Sheets("ER10(cx)").Select Rows("5:9").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("A5").Select ActiveSheet.Paste Sheets("ER10(zht)").Select Rows("5:13").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet1").Select Range("A10").Select ActiveSheet.Paste End Sub

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

    エクセルマクロVBAについて、こんなこと出来ますか？ ■A列からAS列の1行目にヘッダー情報をもつデータベース ■A列に担当者名 ■A列にオートフィルタをかけて各担当ごとにデータを抽出したものを別シートに貼り付けて自動印刷したい ■担当者は都度変わるので、Criteria1:="ｘｘｘ"というようには直接書けない（担当名を自動で抽出したい） ■担当者の数も都度変わる ■補足 一行のデータを特定の雛形に転記する必要があるので別シートに出したいです ちなみに、アナログで記録したコードは以下です。 Sub test1() Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="山田" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="斉藤" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 Sheets("データ抽出シート").Select ActiveSheet.Range("$A$1:$AS$300").AutoFilter Field:=1, Criteria1:="田中" Range("$A$1:$AS$300").Select Selection.Copy Sheets("抽出データ貼付シート").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1 End Sub これ、担当者の抽出を自動でなんとかなりませんか？

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する