回答編集履歴
1
<code>部分
test
CHANGED
@@ -18,13 +18,9 @@
|
|
18
18
|
|
19
19
|
対象のセル番号を取得して、[上下両端入替え処理]へ渡してcallすれば動く筈です。
|
20
20
|
|
21
|
-
|
22
|
-
|
23
21
|
尚、[セル選択範囲の上下を入れ替える]部分はExcel2010にて確認済みです。
|
24
22
|
|
25
|
-
|
23
|
+
```ここに言語を入力
|
26
|
-
|
27
|
-
|
28
24
|
|
29
25
|
Option Explicit
|
30
26
|
|
@@ -44,21 +40,21 @@
|
|
44
40
|
|
45
41
|
Dim lCol2 As Long
|
46
42
|
|
47
|
-
|
43
|
+
|
48
44
|
|
49
45
|
'上行取得・列固定(P16に選択した値/C7:C1000は選択されるべきリスト範囲)
|
50
46
|
|
51
47
|
For Each MyRange In Range("C7:C1000")
|
52
48
|
|
53
|
-
|
49
|
+
If MyRange.Text = Range("P16").Text Then
|
54
|
-
|
50
|
+
|
55
|
-
|
51
|
+
lRow1 = MyRange.Row
|
56
|
-
|
52
|
+
|
57
|
-
|
53
|
+
lCol1 = 13
|
58
|
-
|
54
|
+
|
59
|
-
|
55
|
+
Exit For
|
60
|
-
|
56
|
+
|
61
|
-
|
57
|
+
End If
|
62
58
|
|
63
59
|
Next
|
64
60
|
|
@@ -68,15 +64,15 @@
|
|
68
64
|
|
69
65
|
For Each MyRange In Range("C7:C1000")
|
70
66
|
|
71
|
-
|
67
|
+
If MyRange.Text = Range("S16").Text Then
|
72
|
-
|
68
|
+
|
73
|
-
|
69
|
+
lRow1 = MyRange.Row
|
74
|
-
|
70
|
+
|
75
|
-
|
71
|
+
lCol1 = 13
|
76
|
-
|
72
|
+
|
77
|
-
|
73
|
+
Exit For
|
78
|
-
|
74
|
+
|
79
|
-
|
75
|
+
End If
|
80
76
|
|
81
77
|
Next
|
82
78
|
|
@@ -104,7 +100,7 @@
|
|
104
100
|
|
105
101
|
Dim lCol2 As Long
|
106
102
|
|
107
|
-
|
103
|
+
|
108
104
|
|
109
105
|
lRow1 = Selection.Row
|
110
106
|
|
@@ -122,17 +118,23 @@
|
|
122
118
|
|
123
119
|
|
124
120
|
|
121
|
+
'------------------------------
|
122
|
+
|
123
|
+
' Test_Sample_Miniature
|
124
|
+
|
125
|
+
'------------------------------
|
126
|
+
|
125
127
|
Function 上下両端入替え処理( _
|
126
128
|
|
127
|
-
ByVal mlRow1 As Long, _
|
129
|
+
ByVal mlRow1 As Long, _
|
128
|
-
|
130
|
+
|
129
|
-
ByVal mlCol1 As Long, _
|
131
|
+
ByVal mlCol1 As Long, _
|
130
|
-
|
132
|
+
|
131
|
-
ByVal mlRow2 As Long, _
|
133
|
+
ByVal mlRow2 As Long, _
|
132
|
-
|
134
|
+
|
133
|
-
ByVal mlCol2 As Long _
|
135
|
+
ByVal mlCol2 As Long _
|
134
|
-
|
136
|
+
|
135
|
-
)
|
137
|
+
)
|
136
138
|
|
137
139
|
|
138
140
|
|
@@ -190,13 +192,13 @@
|
|
190
192
|
|
191
193
|
For Each MyObjWork In Range(Cells(mlRow1, lCol), Cells(mlRow2, lCol))
|
192
194
|
|
193
|
-
'
|
195
|
+
'
|
194
|
-
|
196
|
+
|
195
|
-
'両端のみ処理する。
|
197
|
+
'両端のみ処理する。
|
196
|
-
|
198
|
+
|
197
|
-
If MyObjWork.Row = mlRow1 Or MyObjWork.Row = mlRow2 Then
|
199
|
+
If MyObjWork.Row = mlRow1 Or MyObjWork.Row = mlRow2 Then
|
198
|
-
|
200
|
+
|
199
|
-
'
|
201
|
+
'
|
200
202
|
|
201
203
|
blnFLG = True
|
202
204
|
|
@@ -204,13 +206,13 @@
|
|
204
206
|
|
205
207
|
If (Left(MyArray(UBound(MyArray) - iX), 1) = "=") Then
|
206
208
|
|
207
|
-
blnFLG = False
|
209
|
+
blnFLG = False
|
208
210
|
|
209
211
|
End If
|
210
212
|
|
211
213
|
If (Left(MyObjWork.Formula, 1) = "=") Then
|
212
214
|
|
213
|
-
blnFLG = False
|
215
|
+
blnFLG = False
|
214
216
|
|
215
217
|
End If
|
216
218
|
|
@@ -224,11 +226,11 @@
|
|
224
226
|
|
225
227
|
'
|
226
228
|
|
227
|
-
End If
|
229
|
+
End If
|
228
|
-
|
230
|
+
|
229
|
-
iX = iX + 1
|
231
|
+
iX = iX + 1
|
230
|
-
|
232
|
+
|
231
|
-
'
|
233
|
+
'
|
232
234
|
|
233
235
|
Next
|
234
236
|
|
@@ -236,7 +238,7 @@
|
|
236
238
|
|
237
239
|
Next
|
238
240
|
|
239
|
-
|
241
|
+
|
240
242
|
|
241
243
|
上下両端入替え処理 = True
|
242
244
|
|
@@ -248,12 +250,12 @@
|
|
248
250
|
|
249
251
|
Err_処理:
|
250
252
|
|
251
|
-
|
253
|
+
MsgBox "Error " & " ( " & Err.Number & " " & Err.Description & " )"
|
252
254
|
|
253
255
|
'**
|
254
256
|
|
255
257
|
End Function
|
256
258
|
|
257
|
-
|
259
|
+
```
|
258
260
|
|
259
261
|
修正作成時の質問にはお答え出来ないかと思いますが頑張って下さい。
|