質問編集履歴

2

修正後の過去に質問したコードの追記

2018/07/25 00:51

投稿

kamikazelight
kamikazelight

スコア305

test CHANGED
File without changes
test CHANGED
@@ -41,3 +41,139 @@
41
41
  一度切らせて頂いて
42
42
 
43
43
  別質問にてコードの設計について質問します。
44
+
45
+
46
+
47
+ ###修正をした過去に質問をしていたコード
48
+
49
+ ```VBA
50
+
51
+ Option Explicit
52
+
53
+ Option Private Module
54
+
55
+
56
+
57
+
58
+
59
+ Sub MyCopy(ByVal CopyRng As Range, ByVal PasteRng As Range)
60
+
61
+ 'セルの 大体の書式と 値を Copy
62
+
63
+
64
+
65
+ Dim XML As String
66
+
67
+ Dim FormulaR1C1 As Variant
68
+
69
+ Dim RowSize As Long
70
+
71
+ Dim ColumnSize As Long
72
+
73
+ Const ValueDataType = Excel.XlRangeValueDataType.xlRangeValueXMLSpreadsheet
74
+
75
+
76
+
77
+ 'SizeGet
78
+
79
+ RowSize = CopyRng.Rows.Count
80
+
81
+ ColumnSize = CopyRng.Columns.Count
82
+
83
+
84
+
85
+ 'Copy
86
+
87
+ XML = CopyRng.Value(ValueDataType)
88
+
89
+ FormulaR1C1 = CopyRng.FormulaR1C1
90
+
91
+
92
+
93
+ 'Paste
94
+
95
+ PasteRng.Resize(RowSize, ColumnSize).Value(ValueDataType) = XML
96
+
97
+ PasteRng.Resize(RowSize, ColumnSize).FormulaR1C1 = FormulaR1C1
98
+
99
+ End Sub
100
+
101
+
102
+
103
+
104
+
105
+ Sub MyRowCopyInsert(ByVal CopyRng As Range, ByVal PasteRng As Range, Optional ByVal Cut As Boolean = False)
106
+
107
+ 'セルの 大体の書式と 値を Copy
108
+
109
+
110
+
111
+ Dim RowsHeight() As Variant
112
+
113
+ Dim RowSize As Long
114
+
115
+ Dim i As Long
116
+
117
+ Dim j As Long
118
+
119
+
120
+
121
+ 'SizeGet
122
+
123
+ RowSize = CopyRng.Rows.Count
124
+
125
+ ReDim RowsHeight(1 To RowSize)
126
+
127
+ For i = 1 To RowSize
128
+
129
+ RowsHeight(i) = CopyRng.Resize(1, 1).Offset(i - 1).EntireRow.RowHeight
130
+
131
+ Next i
132
+
133
+
134
+
135
+
136
+
137
+ 'Resize
138
+
139
+ Set CopyRng = CopyRng.EntireRow
140
+
141
+ Set PasteRng = PasteRng.EntireRow.Resize(RowSize:=RowSize)
142
+
143
+
144
+
145
+ 'Insert
146
+
147
+ PasteRng.Insert
148
+
149
+
150
+
151
+ 'PasteRow ReSet
152
+
153
+ Set PasteRng = PasteRng.Offset((-1) * RowSize)
154
+
155
+
156
+
157
+ 'CopyPaste
158
+
159
+ MyCopy CopyRng, PasteRng
160
+
161
+ For j = 1 To RowSize
162
+
163
+ PasteRng.Resize(1, 1).Offset(j - 1).EntireRow.RowHeight = RowsHeight(j)
164
+
165
+ Next j
166
+
167
+
168
+
169
+ 'Cut
170
+
171
+ If Cut Then
172
+
173
+ CopyRng.Delete
174
+
175
+ End If
176
+
177
+ End Sub
178
+
179
+ ```

1

ベストアンサー選択後の追記を足しました

2018/07/25 00:51

投稿

kamikazelight
kamikazelight

スコア305

test CHANGED
File without changes
test CHANGED
@@ -27,3 +27,17 @@
27
27
  教えて頂けないでしょうか。
28
28
 
29
29
  宜しくお願い致します。
30
+
31
+
32
+
33
+ ###ベストアンサー選択後の追記
34
+
35
+ プロシージャなどコードの使いまわし=「共通化」
36
+
37
+ 「共通化とするならコード設計から」
38
+
39
+ とのことで土台が無いようなので
40
+
41
+ 一度切らせて頂いて
42
+
43
+ 別質問にてコードの設計について質問します。