回答編集履歴

1

<code>部分

2020/05/21 23:53

投稿

tosi
tosi

スコア553

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
- If MyRange.Text = Range("P16").Text Then
49
+ If MyRange.Text = Range("P16").Text Then
54
-
50
+
55
- lRow1 = MyRange.Row
51
+ lRow1 = MyRange.Row
56
-
52
+
57
- lCol1 = 13
53
+ lCol1 = 13
58
-
54
+
59
- Exit For
55
+ Exit For
60
-
56
+
61
- End If
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
- If MyRange.Text = Range("S16").Text Then
67
+ If MyRange.Text = Range("S16").Text Then
72
-
68
+
73
- lRow1 = MyRange.Row
69
+ lRow1 = MyRange.Row
74
-
70
+
75
- lCol1 = 13
71
+ lCol1 = 13
76
-
72
+
77
- Exit For
73
+ Exit For
78
-
74
+
79
- End If
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
- MsgBox "Error " & " ( " & Err.Number & " " & Err.Description & " )"
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
  修正作成時の質問にはお答え出来ないかと思いますが頑張って下さい。