| |
こんばんは。
あと、ま、これは蛇足ですけど、
コピー元のデータを 配列 に入れておいて、
もうひとつの 配列 に 条件付きで行処理をして転記して
最後にこの配列をまとめて転記先の範囲に値だけ書き込む
という手もありまして。。。
配列内でデータを再配置するのは高速化の常用手段ですので
参考までにサンプルをアップしておきます。
新規「標準モジュール」を追加してそこに
Option Explicit 行からコピーして お試しください。
（注）
・CSVデータは「TMP1」シートの31行目からあるものと仮定。
・転記先シートは Worksheets(3) としています。
・このシートの3行目に項目見出しがあり、
4行目以降にデータを貼り付けるものと仮定しています。
このあたりは 適宜修正してください。
'-------------------------------------- 新規Module
Option Explicit
Enum 列番号
行番号 = 1
適用 = 2
数量 = 3
単位 = 4
単価 = 5
金額 = 6
End Enum
Sub 見積り作成6()
Dim WS As Worksheet
Dim i As Long
Dim j As Long
Dim newLine As Long
Dim PostAddLine As Long
Dim v 'もとのデータ
Dim u '転記用データ
With Worksheets("TMP1") '一時シートのデータを配列に入れる
v = .Range("A31", .Cells(Rows.Count, 2).End(xlUp)) _
.Resize(, 6).Value
End With
'転記先シートの書式Copy 'この部分 吟味されてません
Set WS = Worksheets(3)
If UBound(v) > 29 Then
With WS.Range("A4")
.Resize(29, 6).Copy .Offset(29)
.Offset(29).Resize(29, 6).RowHeight = 27
End With
End If
ReDim u(1 To 29, 1 To 金額)
newLine = 1
For i = 1 To UBound(v)
PostAddLine = 0
'行番号欄に記載のあったとき
str行番号 = v(i, 行番号)
If Len(str行番号) > 0 Then
'マイナス行番号を カッコ付き行番号にします
If str行番号 Like "-*" Then
v(i, 行番号) = "'(" & Mid(str行番号, 2) & ")"
End If
End If
'転記行 条件チェック
If v(i, 適用) Like "*合*計*" Then
PostAddLine = 1 '◆下に空行挿入
ElseIf v(i, 適用) Like "*値*引*" Then '「値引」の文字あり
newLine = newLine + 1 '◆上に空行挿入
ElseIf v(i, 単位) Like "式" And IsEmpty(v(i, 単価)) Then
'単位欄が「式」で 単価欄に記載がないときは
newLine = newLine + 1 '◆上に空行挿入
End If
'指定の行に値転記
For j = 1 To 金額
u(newLine, j) = v(i, j)
Next
newLine = newLine + 1 + PostAddLine '◆次の転記行
Next
WS.Range("A4").Resize(newLine - 1, 6).Value = u
End Sub
|
|
kanabun
- 09/6/17(水) 21:52 -
