teratail
回答率
85.47%
質問するログイン新規登録
トップVBAに関する質問２行以上連続で追加行を増やしたい

編集履歴

回答編集履歴

4

関数名が嘘ついてるので少々変更

2016/12/08 06:57

投稿

Batoh33789
Batoh33789

スコア136

test CHANGED
@@ -108,7 +108,7 @@
108
108
 
109
109
  ' 行数を昇順にソート
110
110
 
111
- Set col = sortCollection(col)
111
+ Set col = getAscSort(col)
112
112
 
113
113
  Dim r As Variant
114
114
 
@@ -138,7 +138,7 @@
138
138
 
139
139
  ' ソート用関数 戻り値はCollection型
140
140
 
141
- Function sortCollection(ByRef col As Collection) As Collection
141
+ Function getAscSort(ByVal col As Collection) As Collection
142
142
 
143
143
  Dim result As New Collection
144
144
 
@@ -164,7 +164,7 @@
164
164
 
165
165
  Loop
166
166
 
167
- Set sortCollection = result
167
+ Set getAscSort= result
168
168
 
169
169
  End Function
170
170
 

3

追記確認しました。

2016/12/08 06:57

投稿

Batoh33789
Batoh33789

スコア136

test CHANGED
@@ -78,4 +78,94 @@
78
78
 
79
79
  ```
80
80
 
81
+ ---------------------------
81
82
 
83
+ さらに、さらに追記確認しました。
84
+
85
+ ---------------------------
86
+
87
+
88
+
89
+ BAが付いた後ですが、下記で出来ます。
90
+
91
+ ```VBA
92
+
93
+ ' 関数名は適当です。
94
+
95
+ Sub test3()
96
+
97
+ ' 選択されている行数を格納
98
+
99
+ Dim col As New Collection
100
+
101
+ Dim v As Variant
102
+
103
+ For Each v In Selection.Rows
104
+
105
+ col.add v.Row
106
+
107
+ Next v
108
+
109
+ ' 行数を昇順にソート
110
+
111
+ Set col = sortCollection(col)
112
+
113
+ Dim r As Variant
114
+
115
+ Dim add As Long
116
+
117
+ ' 選択されている行数はcolの中に入っているので
118
+
119
+ ' ループで回しつつ上から順番に1行ずつコピーして貼り付けを繰り返す（※）
120
+
121
+ For Each r In col
122
+
123
+ r = r + add
124
+
125
+ Rows(r).Copy
126
+
127
+ Rows(r).Insert
128
+
129
+ Rows(r).PasteSpecial
130
+
131
+ add = add + 1
132
+
133
+ Next r
134
+
135
+ End Sub
136
+
137
+
138
+
139
+ ' ソート用関数 戻り値はCollection型
140
+
141
+ Function sortCollection(ByRef col As Collection) As Collection
142
+
143
+ Dim result As New Collection
144
+
145
+ Dim id As Long, i As Long
146
+
147
+ Do Until (col.Count = 0)
148
+
149
+ id = 1
150
+
151
+ For i = 2 To col.Count
152
+
153
+ If col(id) > (col(i)) Then
154
+
155
+ id = i
156
+
157
+ End If
158
+
159
+ Next i
160
+
161
+ result.add col(id)
162
+
163
+ col.Remove id
164
+
165
+ Loop
166
+
167
+ Set sortCollection = result
168
+
169
+ End Function
170
+
171
+ ```

2

追記確認しました２

2016/12/08 06:49

投稿

Batoh33789
Batoh33789

スコア136

test CHANGED
@@ -51,3 +51,31 @@
51
51
  ```
52
52
 
53
53
  のようになります。
54
+
55
+
56
+
57
+ ---------------------------
58
+
59
+ さらに追記確認しました。
60
+
61
+ ---------------------------
62
+
63
+ 上記と組み合わせてお使い頂ければある程度は対応できると思います。
64
+
65
+ ```VBA
66
+
67
+ ' 選択範囲のコピー
68
+
69
+ Selection.Copy
70
+
71
+ ' 選択範囲行数分の挿入
72
+
73
+ Selection.Insert
74
+
75
+ ' 選択範囲の貼り付け
76
+
77
+ Selection.PasteSpecial
78
+
79
+ ```
80
+
81
+

1

追記確認しました。

2016/12/07 08:11

投稿

Batoh33789
Batoh33789

スコア136

test CHANGED
@@ -9,3 +9,45 @@
9
9
  質問の意図を読み違えていたら、スルーして下さい。
10
10
 
11
11
  よろしくお願いします。
12
+
13
+
14
+
15
+ ---------------------------
16
+
17
+ 追記確認致しました。
18
+
19
+ ---------------------------
20
+
21
+
22
+
23
+ 選択されている行数は以下で取得出来ます。
24
+
25
+ ※イミディエイトウィンドウに表示されます。
26
+
27
+ ```VBA
28
+
29
+ Dim r As Variant
30
+
31
+ For Each r In Selection.Rows
32
+
33
+ Debug.Print r.Row
34
+
35
+ Next r
36
+
37
+ ```
38
+
39
+ また、例えば、選択されている行のC列に5を入れる場合は、
40
+
41
+ ```VBA
42
+
43
+ Dim r As Variant
44
+
45
+ For Each r In Selection.Rows
46
+
47
+ r.Cells(3).value = 5
48
+
49
+ Next r
50
+
51
+ ```
52
+
53
+ のようになります。