質問編集履歴

1

追記です。

2018/10/14 16:07

投稿

emon2525
emon2525

スコア12

test CHANGED
File without changes
test CHANGED
@@ -25,3 +25,113 @@
25
25
 
26
26
 
27
27
  何か参考になる記事かこちらの仕様に関してアドバイスの程、、よろしくお願いいたします。
28
+
29
+
30
+
31
+
32
+
33
+
34
+
35
+
36
+
37
+
38
+
39
+ 追記でございます。
40
+
41
+ ここまでは 他の回答を参考に実現できております。
42
+
43
+ 行は挿入できるものの コピーも同時に実行したいと考えております。
44
+
45
+ ご教授いただけると幸いです。
46
+
47
+
48
+
49
+ ```ここに言語を入力
50
+
51
+ Sub InsertRow1()
52
+
53
+
54
+
55
+ Dim i As Long
56
+
57
+ Dim intStart As Long
58
+
59
+ Dim intCol As Long
60
+
61
+ Dim cntBlank As Long
62
+
63
+ Dim AddCnt As Long
64
+
65
+ Dim msg_1 As String
66
+
67
+
68
+
69
+
70
+
71
+
72
+
73
+ intStart = 2 '開始する行数
74
+
75
+ intCol = 2 '数字を読み込む列
76
+
77
+ i = intStart '追加する行数の先頭位置
78
+
79
+ Dim j As Integer '追加する行数の中に既に空白行があったらその行数分
80
+
81
+
82
+
83
+
84
+
85
+ msg_1 = "B列に指定されている変数分追加しますか?"
86
+
87
+
88
+
89
+ If MsgBox(msg_1, vbYesNo) = vbNo Then Exit Sub '行を追加してよいかのポップアップを出す
90
+
91
+
92
+
93
+ Application.ScreenUpdating = False '処理終了まで画面表示はそのまま
94
+
95
+
96
+
97
+ '最終行の1行上から上へ読み込む
98
+
99
+ For i = Cells(Rows.Count, intCol).End(xlUp).Row - 1 To intStart Step -1
100
+
101
+ Select Case Cells(i, intCol).Value
102
+
103
+ Case ""
104
+
105
+ cntBlank = cntBlank + 1 '空白行カウント
106
+
107
+ Case Is >= 2
108
+
109
+ AddCnt = Cells(i, intCol).Value - cntBlank '追加する行数計算
110
+
111
+ 'AddCnt = Cells(i, intCol).Value - cntBlank - 1 '追加する行数計算
112
+
113
+ If AddCnt > 0 Then
114
+
115
+ Range(Rows(i + 1), Rows(i + AddCnt)).Select
116
+
117
+ Selection.Insert '選択された行数分追加
118
+
119
+ End If
120
+
121
+ cntBlank = 0
122
+
123
+ Case Else
124
+
125
+ cntBlank = 0
126
+
127
+ End Select
128
+
129
+ Next i
130
+
131
+
132
+
133
+ Application.ScreenUpdating = True
134
+
135
+ End Sub
136
+
137
+ ```