advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 85 for VBA 強制終了 (0.004 sec.)
vba (14726), 強制終了 (237)
[[20210126100012]]
#score: 16176
@digest: 4250d16f7f0897062845035569092bba
@id: 86467
@mdate: 2021-01-27T02:08:48Z
@size: 7857
@type: text/plain
#keywords: rowsno (92832), xcount (83577), 加行 (46732), 画フ (37464), kaisuu (33599), roop (24794), rowsinsert (20867), 入行 (16065), 動画 (15317), 数). (10887), 定回 (10745), 理回 (10477), ァン (9221), (動 (8470), 上5 (6466), 行数 (5977), ス" (5379), inputbox (5024), activecell (4574), vbinformation (3992), 回数 (3018), insert (2937), 定日 (2633), xldown (2526), 色分 (2509), 追加 (2335), 見直 (2077), 数( (1816), 月3 (1614), 2021 (1435), ンセ (1359), 挿入 (1353)
『同一日付を追加』(動画ファン)
TV録画用の予定表を作成しています。 A列に日付を一括して入力 a2=DATE(G2,H2,1) G2:年度指定 H2:月指定 a3=a2+1 以下a40までオートフィル機能でコピー 「土曜は青、日曜は赤」予定表の曜日を色分けしたいので 「条件付き書式」と「WEEKDAY関数」を組み合わせて曜日を色分けで表示されるようにしています。 ------------------------ 時々同一日に2-3本録画予約がある場合があるので マクロをさくせいする事にしました。 やりたいことは、 指定日に下に新しく空行を作成して 指定日と同じ日付をコピーする。 (土曜、日曜の色分けは指定日の条件をそのまま引き次ぐ) ------------------------------------------ 以下のマクロを作成しましたが 上手く処理されません。 コピーしたい日付を選択してマクロを起動しても指定日の上に空欄ができるだけで 日付が何もコピーされない。 コードの修正はどうすれば良いですか ? Sub Macro3() ' ' Macro3 Macro ' ActiveCell.Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Rows(ActiveCell.Row - 1).Select Selection.Copy ActiveSheet.Paste End Sub < 使用 Excel:Excel2019、使用 OS:Windows10 > ---- VBAの世界では基本的に、シートやセルを明示すれば、いちいちアクティブにしたり選択したりする必要はありません。 ただ、今回の作業はほぼActiveCellの操作してかしてないので↓のようにすればいいんじゃないですか? Sub さんぷる() ActiveCell.Copy ActiveCell.Insert Shift:=xlDown Application.CutCopyMode = False End Sub (もこな2) 2021/01/26(火) 12:28 ---- コードの提示ありがとうございます。 コードを検証すると 例えば、A32(3月3日)を選択してマクロを実行すると A31,A32が3月2日(A33が3月3日)となり 指定したセルの1日前が追加された形式になってしまいます。 (動画ファン) 2021/01/26(火) 13:11 ---- 検索して利用できそうなコードを繋ぎ合わせて以下のマクロを検証中です。 一応、上手く処理できてそうですが 改良点やアドバイスあればお願いします。 Sub RowsInsert_2() ' Dim RowsNo As Long Dim xCount As Integer Dim ROOP As Integer KAISUU: xCount = Application.InputBox("追加行数の数は ?", "追加行数", , , , , , 1) If xCount < 1 Then MsgBox "追加行数は1以上です。指定回数を見直してください。", vbInformation, "追加行数のミス" GoTo KAISUU End If For ROOP = 1 To xCount RowsNo = ActiveCell.Row + 1 Rows(RowsNo).Select Selection.Insert Shift:=xlDown Cells(RowsNo, 1) = Cells(RowsNo - 1, 1).Value 'Cells(RowsNo, 2) = Cells(RowsNo - 1, 2).Value Next ROOP End Sub (動画ファン) 2021/01/26(火) 13:39 ---- ループの回数を1-5に固定するため以下に修正しました。 Sub RowsInsert_2() ' Dim RowsNo As Long Dim xCount As Integer Dim ROOP As Integer KAISUU: xCount = Application.InputBox("追加行数の数は ?", "追加行数 (1-5)", , , , , , 1) '処理回数指定 If xCount < 1 Or xCount > 5 Then MsgBox "追加行数は1以上5以下です。指定回数を見直してください。", vbInformation, "追加行数のミス" GoTo KAISUU End If For ROOP = 1 To xCount RowsNo = ActiveCell.Row + 1 Rows(RowsNo).Select Selection.Insert Shift:=xlDown Cells(RowsNo, 1) = Cells(RowsNo - 1, 1).Value 'Cells(RowsNo, 2) = Cells(RowsNo - 1, 2).Value Next ROOP End Sub ----------------------------- inputBoxでキャンセルをクリックした場合の処理を追加しようとしましたが 以下のコードでは上手くいきません。 修正できればお願いします。 KAISUU: Do xCount = Application.InputBox("追加行数の数は ?", "追加行数 (1-5)", , , , , , 1) '処理を強制終了 If StrPtr(xCount) Then Exit Sub '処理回数指定 If xCount < 1 Or xCount > 5 Then MsgBox "追加行数は1以上5以下です。指定回数を見直してください。", vbInformation, "追加行数のミス" GoTo KAISUU If IsNumeric(ans) Then flg = True End If Loop Until flg = True (動画ファン) 2021/01/26(火) 14:49 ---- 一応、上手く処理できてそうですが 改良点やアドバイスあればお願いします。 Sub RowsInsert_2() ' Dim RowsNo As Long Dim xCount As Integer Dim ROOP As Integer KAISUU: xCount = Application.InputBox("追加行数の数は ?", "追加行数 (1-5)", , , , , , 1) '処理キャンセル If xCount = 0 Then Exit Sub Else '処理回数は1-5でそれ以外は、再入力 If xCount < 1 Or xCount > 5 Then MsgBox "追加行数は1以上5以下です。指定回数を見直してください。", vbInformation, "追加行数のミス" GoTo KAISUU End If End If '行追加 For ROOP = 1 To xCount RowsNo = ActiveCell.Row + 1 Rows(RowsNo).Select Selection.Insert Shift:=xlDown Cells(RowsNo, 1) = Cells(RowsNo - 1, 1).Value 'Cells(RowsNo, 2) = Cells(RowsNo - 1, 2).Value Next ROOP (動画ファン) 2021/01/26(火) 16:42 ---- 2021/01/26(火) 14:49 の投稿についてコメントします。 なお、「上手くいきません」の詳細が「If StrPtr(xCount) Then の条件分岐が想定通りに行かない」であると推測しての回答です。 恐らく、↓このあたりを参考になさったのかと思いますが、 インストラクターのネタ帳 https://www.relief.jp/docs/excel-vba-inputbox-cancel.html 同じサイト内にも記載があるように、InputBoxには2種類あります。 https://www.relief.jp/docs/excel-vba-inputbox-function-application-inputbox-method.html 動画ファンさんが現在コードに組み込んでいらっしゃる Application.InputBox と、キャンセル処理を組み込むコード内で紹介されている InputBox関数 は別物です。 (じゃふ) 2021/01/26(火) 16:48 ---- じゃふさん、回答感謝します。 ネタ元は提示されたURLで間違いありません。 ど素人がコードの継ぎ接ぎで何とかしているので InputBox(関数)とAppication.InputBox(メソッド)はまったくの別物 なのを同じものと思ってしまったのがコードが「上手く行かない」理由でした。 (動画ファン) 2021/01/26(火) 17:38 ---- >例えば、A32(3月3日)を選択してマクロを実行すると >A31,A32が3月2日(A33が3月3日)となり >指定したセルの1日前が追加された形式になってしまいます。 それ、セルに↓のような数式が書かれてませんか? =A31+1 後段の挿入行数を指定する場合でも、ループ処理じゃなくてもよい気がします。 Sub さんぷる2() Const 挿入行数 As Long = 2 ActiveCell.Offset(1).Resize(挿入行数).Insert Shift:=xlDown ActiveCell.Offset(1).Resize(挿入行数).Value = ActiveCell.Value End Sub (もこな2) 2021/01/26(火) 17:57 ---- もこな2さん、 回答ありがとうございます。 >それ、セルに↓のような数式が書かれてませんか? >=A31+1 最初の質問に a3=a2+1 以下a40までオートフィル機能でコピー と現在の状態(条件)を記載しました。 -------------------------------- 提示されたコードを検証したいと思います。 (offset、Resizeはど素人には理解するのが現段階では難しいです。) Sub さんぷる2() Const 挿入行数 As Long = 2 ActiveCell.Offset(1).Resize(挿入行数).Insert Shift:=xlDown ActiveCell.Offset(1).Resize(挿入行数).Value = ActiveCell.Value End Sub (動画ファン) 2021/01/26(火) 18:33 ---- >最初の質問に〜記載しました。 本当ですね。失礼しました。 であれば、(数式がコピーされちゃうので)普通のコピペではダメですね。 >offset、Resizeはど素人には理解するのが現段階では難しいです。 わかってしまえば大したことはしてないです。 ActiveCellがA32セルだとすると Offset(1) で1行したにずらすのでA33セルという意味になり Range("A33").Resize(挿入行数) で縦2行、横はそのままにセル範囲を変更なので、A33:A34になり、 Range("A33:A34").Insert Shift:=xlDown でそのままA33:A34に挿入して下にずらす という命令になってます。 (もこな2) 2021/01/27(水) 09:22 ---- もこな2さん、コードの解説ありがとうございます。 セルに関しては、RangeやCellsまでで それから先のOffsetやResizeを勉強を後回しにしていました。 (こちらのような援助サイトやサイトのコードのツギハギで何とか凌いで来ました。) 何とか理解がもう少し先まで進むように努力します。 (動画ファン) 2021/01/27(水) 11:08 ...
http://www.excel.studio-kazu.jp/wiki/kazuwiki/202101/20210126100012.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97023 documents and 608156 words.

訪問者:カウンタValid HTML 4.01 Transitional