teratail header banner
teratail header banner
質問するログイン新規登録

質問編集履歴

1

追記です。

2018/10/14 16:07

投稿

emon2525
emon2525

スコア12

title CHANGED
File without changes
body CHANGED
@@ -11,4 +11,59 @@
11
11
 
12
12
  行数に入ってる値をもとに行を挿入しコピーを行いたいと思っております。
13
13
 
14
- 何か参考になる記事かこちらの仕様に関してアドバイスの程、、よろしくお願いいたします。
14
+ 何か参考になる記事かこちらの仕様に関してアドバイスの程、、よろしくお願いいたします。
15
+
16
+
17
+
18
+
19
+
20
+ 追記でございます。
21
+ ここまでは 他の回答を参考に実現できております。
22
+ 行は挿入できるものの コピーも同時に実行したいと考えております。
23
+ ご教授いただけると幸いです。
24
+
25
+ ```ここに言語を入力
26
+ Sub InsertRow1()
27
+
28
+ Dim i As Long
29
+ Dim intStart As Long
30
+ Dim intCol As Long
31
+ Dim cntBlank As Long
32
+ Dim AddCnt As Long
33
+ Dim msg_1 As String
34
+
35
+
36
+
37
+ intStart = 2 '開始する行数
38
+ intCol = 2 '数字を読み込む列
39
+ i = intStart '追加する行数の先頭位置
40
+ Dim j As Integer '追加する行数の中に既に空白行があったらその行数分
41
+
42
+
43
+ msg_1 = "B列に指定されている変数分追加しますか?"
44
+
45
+ If MsgBox(msg_1, vbYesNo) = vbNo Then Exit Sub '行を追加してよいかのポップアップを出す
46
+
47
+ Application.ScreenUpdating = False '処理終了まで画面表示はそのまま
48
+
49
+ '最終行の1行上から上へ読み込む
50
+ For i = Cells(Rows.Count, intCol).End(xlUp).Row - 1 To intStart Step -1
51
+ Select Case Cells(i, intCol).Value
52
+ Case ""
53
+ cntBlank = cntBlank + 1 '空白行カウント
54
+ Case Is >= 2
55
+ AddCnt = Cells(i, intCol).Value - cntBlank '追加する行数計算
56
+ 'AddCnt = Cells(i, intCol).Value - cntBlank - 1 '追加する行数計算
57
+ If AddCnt > 0 Then
58
+ Range(Rows(i + 1), Rows(i + AddCnt)).Select
59
+ Selection.Insert '選択された行数分追加
60
+ End If
61
+ cntBlank = 0
62
+ Case Else
63
+ cntBlank = 0
64
+ End Select
65
+ Next i
66
+
67
+ Application.ScreenUpdating = True
68
+ End Sub
69
+ ```