回答編集履歴

4

ロジック解説の追加

2017/06/02 06:01

投稿

hatena19
hatena19

スコア33715

test CHANGED
@@ -166,4 +166,20 @@
166
166
 
167
167
 
168
168
 
169
+ **ロジック**
169
170
 
171
+ 最終行の1行上から順に前に移動して読み込む(最終行は空白行挿入する必要はない)
172
+
173
+
174
+
175
+ 上へ移動するときに、
176
+
177
+ 空白行をカウントしていく
178
+
179
+ 2以上の数値がでたら、そこからカウントした空白行を引いた行数分挿入する、その後空白行カウントを0に初期化する
180
+
181
+ それ以外は、空白行カウントを0に初期化する
182
+
183
+
184
+
185
+

3

コード修正、画像変更

2017/06/02 06:01

投稿

hatena19
hatena19

スコア33715

test CHANGED
@@ -120,9 +120,9 @@
120
120
 
121
121
 
122
122
 
123
+ '最終行の1行上から上へ読み込む
123
124
 
124
-
125
- For i = Cells(Rows.Count, intCol).End(xlUp).Row - 1 To intStart Step -1 '最終行の1行上から読み込む
125
+ For i = Cells(Rows.Count, intCol).End(xlUp).Row - 1 To intStart Step -1
126
126
 
127
127
  Select Case Cells(i, intCol).Value
128
128
 
@@ -132,7 +132,7 @@
132
132
 
133
133
  Case Is >= 2
134
134
 
135
- AddCnt = Cells(i, intCol).Value - cntBlank '追加する行数計算
135
+ AddCnt = Cells(i, intCol).Value - cntBlank - 1 '追加する行数計算
136
136
 
137
137
  If AddCnt > 0 Then
138
138
 
@@ -160,7 +160,9 @@
160
160
 
161
161
  ```
162
162
 
163
+ 実行結果
164
+
163
- 実行結果![イメージ説明](99adf58644b680f5dab6451d5fba578a.png)
165
+ ![イメージ説明](51a205f8b2bb249af803d91a8e4537af.png)
164
166
 
165
167
 
166
168
 

2

サンプルコードの追加

2017/06/02 05:55

投稿

hatena19
hatena19

スコア33715

test CHANGED
@@ -55,3 +55,113 @@
55
55
 
56
56
 
57
57
  `Cells(Rows.Count, intCol).End(xlUp).Row` でデータのある最終行が取得できます。
58
+
59
+
60
+
61
+ 追記
62
+
63
+ ---
64
+
65
+ 細かい仕様は不明ですが、やりたいことは下記のようなことかな。
66
+
67
+
68
+
69
+ N列にある数値分の空白行のその行の下に挿入する。
70
+
71
+ ただし、空白行がすでにある場合は、それを含めて指定の行数になるように挿入する。
72
+
73
+
74
+
75
+ ```
76
+
77
+ Sub InsertRow1()
78
+
79
+
80
+
81
+ Dim i As Long
82
+
83
+ Dim intStart As Long
84
+
85
+ Dim intCol As Long
86
+
87
+ Dim cntBlank As Long
88
+
89
+ Dim AddCnt As Long
90
+
91
+ Dim msg_1 As String
92
+
93
+
94
+
95
+
96
+
97
+
98
+
99
+ intStart = 2 '開始する行数
100
+
101
+ intCol = 14 '数字を読み込む列
102
+
103
+ i = intStart '追加する行数の先頭位置
104
+
105
+ Dim j As Integer '追加する行数の中に既に空白行があったらその行数分
106
+
107
+
108
+
109
+
110
+
111
+ msg_1 = "N列に指定されている員数-1行を追加しますか"
112
+
113
+
114
+
115
+ If MsgBox(msg_1, vbYesNo) = vbNo Then Exit Sub '行を追加してよいかのポップアップを出す
116
+
117
+
118
+
119
+ Application.ScreenUpdating = False '処理終了まで画面表示はそのまま
120
+
121
+
122
+
123
+
124
+
125
+ For i = Cells(Rows.Count, intCol).End(xlUp).Row - 1 To intStart Step -1 '最終行の1行上から読み込む
126
+
127
+ Select Case Cells(i, intCol).Value
128
+
129
+ Case ""
130
+
131
+ cntBlank = cntBlank + 1 '空白行カウント
132
+
133
+ Case Is >= 2
134
+
135
+ AddCnt = Cells(i, intCol).Value - cntBlank '追加する行数計算
136
+
137
+ If AddCnt > 0 Then
138
+
139
+ Range(Rows(i + 1), Rows(i + AddCnt)).Select
140
+
141
+ Selection.Insert '選択された行数分追加
142
+
143
+ End If
144
+
145
+ cntBlank = 0
146
+
147
+ Case Else
148
+
149
+ cntBlank = 0
150
+
151
+ End Select
152
+
153
+ Next i
154
+
155
+
156
+
157
+ Application.ScreenUpdating = True
158
+
159
+ End Sub
160
+
161
+ ```
162
+
163
+ 実行結果![イメージ説明](99adf58644b680f5dab6451d5fba578a.png)
164
+
165
+
166
+
167
+

1

書式の改善

2017/06/02 05:45

投稿

hatena19
hatena19

スコア33715

test CHANGED
@@ -54,4 +54,4 @@
54
54
 
55
55
 
56
56
 
57
- Cells(Rows.Count, intCol).End(xlUp).Row でデータのある最終行が取得できます。
57
+ `Cells(Rows.Count, intCol).End(xlUp).Row` でデータのある最終行が取得できます。