| |
▼なまけもの さん：
>以下のコードを作ったのですが、
>もっと簡単にすることは可能なのでしょうか?
配列内で転記してみますか？
専用下請けサブプロシージャを２つ作っておきます。
１つは trans2 で 転記元2列 → 転記先1列
もうひとつは
trans1 で 転記元1列（連続データ）→転記先（1行おき）
呼び出すとき、各範囲の先頭セルと 転記元側の行数を渡してやります。
Sub 部品外注抽出()
Const m = 18 '元範囲行数
'部品の品名 + 部品の型式またはサイズ (1ページ目)
trans2 [B56], [C56], m, [AP11]
' 部品の数量(1ページ目)
trans1 [G56], m, [AR11]
'部品の 単価 (1ページ目)
trans1 [D56], m, [AT11]
'外注の品名 + 型式またはサイズ (1ページ目)
trans2 [J56], [P56], m, [BB11]
' 外注の数量 (1ページ目)
trans1 [W56], m, [BD11]
'外注の 単価 (1ページ目)
trans1 [U56], m, [BE11]
'部品の品名 + 部品の型式またはサイズ (1ページ目)
trans2 [B74], [C74], m, [AP53]
' 部品の数量(1ページ目)
trans1 [G74], m, [AR53]
'部品の 単価 (1ページ目)
trans1 [J74], m, [BB53]
End Sub
Private Sub trans2(c1 As Range, c2 As Range, m As Long, r As Range)
Dim a, b
Dim v
Dim i As Long, j As Long, n As Long: n = m + m
a = c1.Resize(m).Value
b = c2.Resize(m).Value
v = r.Resize(n).Value
For i = 1 To n Step 2
j = j + 1
v(i, 1) = a(j, 1)
v(i + 1, 1) = b(j, 1)
Next
r.Resize(n).Value = v
End Sub
Private Sub trans1(c1 As Range, m As Long, r As Range)
Dim a
Dim v
Dim i As Long, j As Long, n As Long: n = m + m
a = c1.Resize(m).Value
v = r.Resize(n).Value
For i = 1 To n Step 2
j = j + 1
v(i, 1) = a(j, 1)
Next
r.Resize(n).Value = v
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
