回答編集履歴
1
<code>部分
answer
CHANGED
|
@@ -8,10 +8,8 @@
|
|
|
8
8
|
こちら動作確認できましたら、[対象の上行下行の位置を取得する]を
|
|
9
9
|
頑張ってご自分で修正作成してみて下さい。
|
|
10
10
|
対象のセル番号を取得して、[上下両端入替え処理]へ渡してcallすれば動く筈です。
|
|
11
|
-
|
|
12
11
|
尚、[セル選択範囲の上下を入れ替える]部分はExcel2010にて確認済みです。
|
|
13
|
-
|
|
12
|
+
```ここに言語を入力
|
|
14
|
-
|
|
15
13
|
Option Explicit
|
|
16
14
|
|
|
17
15
|
Function 対象の上行下行の位置を取得する()
|
|
@@ -21,23 +19,23 @@
|
|
|
21
19
|
Dim lCol1 As Long
|
|
22
20
|
Dim lRow2 As Long
|
|
23
21
|
Dim lCol2 As Long
|
|
24
|
-
|
|
22
|
+
|
|
25
23
|
'上行取得・列固定(P16に選択した値/C7:C1000は選択されるべきリスト範囲)
|
|
26
24
|
For Each MyRange In Range("C7:C1000")
|
|
27
|
-
|
|
25
|
+
If MyRange.Text = Range("P16").Text Then
|
|
28
|
-
|
|
26
|
+
lRow1 = MyRange.Row
|
|
29
|
-
|
|
27
|
+
lCol1 = 13
|
|
30
|
-
|
|
28
|
+
Exit For
|
|
31
|
-
|
|
29
|
+
End If
|
|
32
30
|
Next
|
|
33
31
|
|
|
34
32
|
'下行取得・列固定(S16に選択した値/C7:C1000は選択されるべきリスト範囲)
|
|
35
33
|
For Each MyRange In Range("C7:C1000")
|
|
36
|
-
|
|
34
|
+
If MyRange.Text = Range("S16").Text Then
|
|
37
|
-
|
|
35
|
+
lRow1 = MyRange.Row
|
|
38
|
-
|
|
36
|
+
lCol1 = 13
|
|
39
|
-
|
|
37
|
+
Exit For
|
|
40
|
-
|
|
38
|
+
End If
|
|
41
39
|
Next
|
|
42
40
|
|
|
43
41
|
'実行
|
|
@@ -51,7 +49,7 @@
|
|
|
51
49
|
Dim lCol1 As Long
|
|
52
50
|
Dim lRow2 As Long
|
|
53
51
|
Dim lCol2 As Long
|
|
54
|
-
|
|
52
|
+
|
|
55
53
|
lRow1 = Selection.Row
|
|
56
54
|
lCol1 = Selection.Column
|
|
57
55
|
lRow2 = lRow1 + Selection.Rows.Count - 1
|
|
@@ -60,12 +58,15 @@
|
|
|
60
58
|
|
|
61
59
|
End Function
|
|
62
60
|
|
|
61
|
+
'------------------------------
|
|
62
|
+
' Test_Sample_Miniature
|
|
63
|
+
'------------------------------
|
|
63
64
|
Function 上下両端入替え処理( _
|
|
64
|
-
ByVal mlRow1 As Long, _
|
|
65
|
+
ByVal mlRow1 As Long, _
|
|
65
|
-
ByVal mlCol1 As Long, _
|
|
66
|
+
ByVal mlCol1 As Long, _
|
|
66
|
-
ByVal mlRow2 As Long, _
|
|
67
|
+
ByVal mlRow2 As Long, _
|
|
67
|
-
ByVal mlCol2 As Long _
|
|
68
|
+
ByVal mlCol2 As Long _
|
|
68
|
-
)
|
|
69
|
+
)
|
|
69
70
|
|
|
70
71
|
Dim blnFLG As Boolean
|
|
71
72
|
|
|
@@ -94,37 +95,37 @@
|
|
|
94
95
|
'
|
|
95
96
|
iX = 0
|
|
96
97
|
For Each MyObjWork In Range(Cells(mlRow1, lCol), Cells(mlRow2, lCol))
|
|
97
|
-
|
|
98
|
+
'
|
|
98
|
-
|
|
99
|
+
'両端のみ処理する。
|
|
99
|
-
|
|
100
|
+
If MyObjWork.Row = mlRow1 Or MyObjWork.Row = mlRow2 Then
|
|
100
|
-
|
|
101
|
+
'
|
|
101
102
|
blnFLG = True
|
|
102
103
|
'
|
|
103
104
|
If (Left(MyArray(UBound(MyArray) - iX), 1) = "=") Then
|
|
104
|
-
|
|
105
|
+
blnFLG = False
|
|
105
106
|
End If
|
|
106
107
|
If (Left(MyObjWork.Formula, 1) = "=") Then
|
|
107
|
-
|
|
108
|
+
blnFLG = False
|
|
108
109
|
End If
|
|
109
110
|
If blnFLG = True Then
|
|
110
111
|
MyObjWork.Formula = MyArray(UBound(MyArray) - iX)
|
|
111
112
|
MyObjWork.NumberFormatLocal = MyNFLArray(UBound(MyNFLArray) - iX)
|
|
112
113
|
End If
|
|
113
114
|
'
|
|
114
|
-
|
|
115
|
+
End If
|
|
115
|
-
|
|
116
|
+
iX = iX + 1
|
|
116
|
-
|
|
117
|
+
'
|
|
117
118
|
Next
|
|
118
119
|
'
|
|
119
120
|
Next
|
|
120
|
-
|
|
121
|
+
|
|
121
122
|
上下両端入替え処理 = True
|
|
122
123
|
|
|
123
124
|
Exit Function
|
|
124
125
|
'**
|
|
125
126
|
Err_処理:
|
|
126
|
-
|
|
127
|
+
MsgBox "Error " & " ( " & Err.Number & " " & Err.Description & " )"
|
|
127
128
|
'**
|
|
128
129
|
End Function
|
|
129
|
-
|
|
130
|
+
```
|
|
130
131
|
修正作成時の質問にはお答え出来ないかと思いますが頑張って下さい。
|