VBAの行数にカーソル位置対応

このQ&Aのポイント
  • VBAのコードを使用して、不揃いな行数にカーソル位置を対応させる方法について説明します。
  • 特定のシートで行番号が不揃いな場合、カーソルを適切な位置に移動させるためのVBAコードを提供します。
  • コード内で使用する範囲の変更にも対応するため、要件に応じて行番号を調整する方法も解説します。
回答を見る
  • ベストアンサー

vba 不揃いの行数にカーソル位置対応

os_xp //// ex_2003 Sub goo() ' goo Macro ' Keyboard Shortcut: Ctrl+g ' Range("A65524").Select Selection.End(xlUp).Select Rows("669:669").Select '(1)-----次回及び 他のシートは不揃いの為 Selection.Copy Rows("670:670").Select '(2)-----(1)が位置が変化するからここも対応 ActiveSheet.Paste Application.CutCopyMode = False Range("A669:F669").Select '-----範囲の変更ありの予定 Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False Range("BD669:BG669").Select '-----範囲の変更ありの予定 Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False Range("A672").Select '(3)-----次回及び 他のシートは不揃いの為 最後に記録の2段下にカーソルが来て欲しい End Sub ' 'どのシートでも (1) (2) (3) が対応してくれないか?。 '

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

こんにちは。 最初に、 >*N88BASICのプログラムに行番号を付けられたのですが **vbaではどうなんでしょうか?* VBEditor には、行番号は無視するような機能は残っています。ただ、VBEditor 自身で、番号を振る機能を持っていないのです。言い換えると、Goto ラベル(番号)機能が残っているわけです。あえて、番号を書く人がいますが、正直なところ、分かりにくいです。掲示板には、Goto 絶対禁止という原理主義者さんもいるようですが、あまり多用しなければよいと思います。(あまり読みやすいとは思いませんが) 私の持っている、"MZ-Tool" というVBAのユーティリティに、"Add Line Number" という機能はありますが、実際には使いません。 以下、ご質問の内容をまとめるとこのようなコードになります。 ステップモードで、一度、試してみると良いです。 なれないと、なかなか、このようには書けませんが、加工するのは簡単だと思います。 Value = Value で、値コピーになります。 '--------------------------------------- '標準モジュールのみ Sub gooR()   Dim sh As Worksheet   For Each sh In Worksheets 'シート全部     sh.Activate '(3)があるために、必要     With Range("A65536").End(xlUp)       .EntireRow.Copy .Offset(1) '(1),(2)       'A-Fまで 1列目~6列目       .Resize(, 6).Value = .Resize(, 6).Value       'BD-BG '56列目~その列含め4列目       .Offset(, 55).Resize(, 4).Value = .Offset(, 55).Resize(, 4).Value       '元の行から3行下       .Offset(3).Select '(3)     End With   Next sh End Sub >(3)次回及び 他のシートは不揃いの為 最後に記録の2段下にカーソルが来て欲しい (3) がなければ、このマクロは、もっとずっと速くループします。次回のことを考える必要がなければ、それは取り去ってもよいと思います。

haro-goo
質問者

補足

お世話になりました。 *Goto 絶対禁止という原理主義者 意味はわかります。当初利用して苦労しました。 今回は質問時に行番号で説明に使う予定でした。 またお会いする機会をーーーー。

その他の回答 (2)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんばんは。 >次回及び 他のシートは不揃いの為 最後に記録の2段下にカーソルが来て欲しい その元のコードからだと、A列から始まっているので、2段下でも、2段開けるようですから、Offset(3) のようです。 Range("A65536").End(xlUp).Offset(3).Select Selection.EntireRow.Select ということだと思います。Offset を使います。 ただ、そのコードの内容からすると、4行で納まりますね。 それと、このコードの内容ですと、文章で説明していただいたほうが、分かりやすいです。

haro-goo
質問者

補足

晩くまでお世話になります。 10/29の内容確認しました。有難うございます 改めて!! *作業用記録ブック 多数  *ブック壱に対してシート壱   *記録範囲は列A~BM  *行 11~ 300も有れば1500も有り?(不揃い)ここで悩んでいるのです。 **最後尾の行をその行の下にコピーする。次--最初の最後尾のA-F,BD-BGをマウスでA-Fコピー、形式を選択して貼り付け、値、OK、の順でBD-BGも同じにしている。 Rows("各シートに対応").Select '(1)-----次回及び 他のシートは不揃いの為 Selection.Copy Rows("各シートに対応").Select '(2)-----(1)が位置が変化するからここも対応 (A)---Range("A669:F669").Select '-----範囲の変更ありの予定 (B)---Range("BD669:BG669").Select '-----範囲の変更ありの予定 (A)はA~FをA~Gと変更予定ですがその時はコードを自分でかきなおしをします。(B)も同じ考え。 ご親切に!!!! 追)回答頂けるようでしたら  *N88BASICのプログラムに行番号を付けられたのですが **vbaではどうなんでしょうか?**   

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

こんな回答者にVBA弧オードを解読させるのでなく、何がしたいか文章で説明してもらえませんか。回答者はテストを受けているのではないはずです。 マクロの記録風そのままで、読みにくいし。 コピー張り付けしているようだが、どういうルール=基準で行を選んでいるのかとか。 >不揃いの行数 とは一定の間隔の行ではないということ?

関連するQ&A

  • エクセルマクロ 繰り返して、別のシートへコピーしたい

    エクセルマクロ 繰り返して、別のシートへコピーしたい マクロ初心者のため、やり方が全くわかりません。 どなたか教えてください。 やりたいことは、 コピーするシートはあらかじめ作成しています。 簡素化の方法がわからないので、 とりあえず自分で作ってみたものが下にあるものです。 繰り返す方法がわからないので、 どなたか教えてください。 よろしくお願いします。 以下、作成したマクロです。 1行目から10行目まで繰り返したくて、 1行目から2行目のセルの移動の差は10行目までかわりません。 '1行目 Sheets("Sheet1").Select Range("B14:C14").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B15:C17").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False '2行目 Sheets("Sheet1").Select Range("B18:C18").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B19:C21").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B2").Select Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False

  • マクロについて教えてください

    マクロの超初心者です。 数式を入力しているのではなく、配付物をエクセルで作成しているのですが、同じもの(氏名や項目は違いますが)を100枚ほど作成しているのでマクロを・・・と思ったのですがやり方が全く分かりません。 sheet1からsheet2に下記のようにデータを写したいのですが、やり方を教えてください。 ●氏名が入力されています sheet1(A9) → sheet2(C2) sheet1(E9) → sheet2(C5) sheet1(I9) → sheet2(C8) ●項目1 sheet1(A8) → sheet2(E3) sheet1(E8) → sheet2(E6) sheet1(I8) → sheet2(E9) ●項目2 sheet1(A18~D18の結合セル) → sheet2(E2) sheet1(E18~H18の結合セル) → sheet2(E5) sheet1(I18~L18の結合セル) → sheet2(E8) と反映させたいのですが、250行あるのですが、 簡単にマクロで出来ないでしょうか?? ちなみに↓コレが上記の内容で作ってみたものです。 わかりずらい質問でスイマセン。 Range("A9").Select Selection.Copy Sheets("sheet2").Select Range("C2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E6").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E9").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A18:D18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E18:H18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I18:L18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

  • Excel 繰り返しマクロ

    下記のようなマクロを使ってn個あるシートの内容を「集計」シートにコピーさせるようにしました。 (自動マクロとの組合せなので、スマートではないかもしれませんが) でも、これだと「集計」シートもコピー作業を行ってしまうので、 「集計」シートはコピー作業をしないように除外したいのですが、どうしたら良いのでしょう? 実際にはシート数は30程度、コピペ項目は1シートあたり30項目程度あります。 よろしくお願いします。 ------------------------- Sub テスト2() ' For i = 1 To Worksheets.Count '案件番号等コピー ' Sheets(i).Select Range("D3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("A4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '案件名 Sheets(i).Select Range("F3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("B4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '国名 Sheets(i).Select Range("E3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("C4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '選択セルの解放 Application.CutCopyMode = False '行挿入 ' Sheets("集計").Select Rows("4:4").Select Selection.Insert Shift:=xlDown Next i End Sub

  • 複数シートの一定範囲を、他シートの表に貼り付けたい

    Win7 Excel2007 でマクロ作成中の初心者です。 複数シートの一定の範囲を、総括表シートの中にある表に貼り付けたいです。 いろいろサイト探しましたが方法がわかりません。どうかご教示おねがいします。 Sub 総括表シートに貼り付け() ' Dim list, sheetName Application.ScreenUpdating = False Const EXCEPT_NAME = "総括表 保管用" For Each sheetName In ActiveWorkbook.Worksheets If InStr(EXCEPT_NAME, sheetName.Name) = 0 Then Sheets(sheetName.Name).Activate ActiveSheet.Unprotect   複貼り付け用部品 ActiveSheet.Protect End If Next End Sub -------------------------------------------- Sub 複貼り付け用部品() ’自動記録のコード 'すべてのシートの Range("AW7:AW34")の範囲を総括表シートに貼り付け '貼り付け位置は、総括表のシートのD列からに順番に貼り付け ActiveSheet.Unprotect Range("AW7:AW34").Select '最初のシート Selection.Copy Range("D4:D31").Select '総括表シートのD列に貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AW7:AW34").Select '2番目のシート Application.CutCopyMode = False Selection.Copy Range("E4:E31").Select '総括表シートのE列に貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AW7:AW34").Select '3番目のシート Application.CutCopyMode = False Selection.Copy Range("F4:F31").Select '総括表シートのF列に貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("AW7:AW34").Select '4番目のシート Application.CutCopyMode = False Selection.Copy Range("G4:G31").Select '総括表シートのG列に貼り付け Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '以下続く End Sub

  • こんなマクロなんですが。

    下記のマクロでエクセルの表からデータ(文字列)を取得するようにしたいとおもっています。 Range("B23").Select Selection.Copy Range("F23").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("B24").Select Selection.Copy Range("F24").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("B25").Select Application.CutCopyMode = False Sheets("September 03").Copy Before:=Sheets(2)          ←ここ Selection.Copy Sheets("September 03 (2)").Select                   ←ここ Sheets("September 03 (2)").Name = "September 10"       ←ここ Range("B33").Select Application.CutCopyMode = False ActiveWindow.SmallScroll Down:=-15 Range("F12:L18").SelectEnd Sub と、まだ続くんですが、とりあえずここまでで。 番地のデータを取り込むようにしたいんですが、うまくいきません。 ←ここ っていうのがまさにそれです。

  • 色々なものを見ながら作っている初心者です。

    色々なものを見ながら作っている初心者です。 よろしくお願いします。 VBAでのエラー対処について 下記のマクロを実行すると、実行時 「Selection.Resize(, Selection.Columns.Count - 2).Select」のところで セルがブランクだった時にエラーが出てします。 対処の方法を教えていただけませんでしょうか? よろしくお願いします。 Sheets("sheetB1").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("D12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB1").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("E12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("B1").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetB2").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("J12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB2").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("K12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("steetB2").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=Fals

  • Excelでマクロを繰り返したい。

    Excelでマクロを記録したら以下のようになりました このマクロを以下の条件で繰り返したいのですが。 Sub Macro1() '------------- '----------------------- ' Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=5*", Operator:=xlAnd, _ Criteria2:="<>5@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=6*", Operator:=xlAnd, _ Criteria2:="<>6@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=7*", Operator:=xlAnd, _ Criteria2:="<>7@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=8*", Operator:=xlAnd, _ Criteria2:="<>8@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 条件= Field:は4~35位まで変動します 一連の動作をコピーして手作業で数字を変えてみたのですが プロージャが大きすぎてエラーになってしまいます。 何か良い方法は無いでしょうか?。

  • 指定セルをコピー

    A2~A5,D2~D5,G2~G5をコピーしJ~P列2~5行に値を貼付け続いて9~13行、16~20行もJ~P列に貼り付けたいのですが7~8,14~15行にはセル結合されているところもあります。VBAで下記コードを入力しましたがあまりにデータが多く何か良い方法VBAコードはありますか。(For~Nextなど使用すれば良いのでしょうか) 環境はoffice2013です。 Range("A2:A6").Select Selection.Copy Range("J2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D2:D6").Select Selection.Copy Range("M2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False  Application.CutCopyMode = False

  • エクセルマクロ実行中に固まります

    単純処理を連発させているのですが、最後まで実行されず、 途中で固まってしまいます。こういう場合はどのように 対処したらよいのでしょうか? VBAに埋め込むとよいコードなどあれば教えてください。 コードのひとかたまりは下記のようなものです。 これを100連発ほどさせます。 Range("D4:K4").Select       ...計算式がはいっています Selection.Copy Range("D5:K16").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False

  • エクセルで大量処理する場合にフリーズを防ぐ方法

    エクセルマクロで単純処理を連発させているのですが、途中でフリーズてしまいます。大量処理する場合、フリーズを防ぐ方法はどのようなものがありますでしょうか?VBAに埋め込むとよいコードなどあれば教えてください。 コードのひとかたまりは下記のようなものです。 これをシートを替えて100連発ほどさせます。 Range("A1:Z1").Select...複雑な計算式がはいっています Selection.Copy Range("A1:K10000").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False

専門家に質問してみよう