| |
▼mori さん：
>「合計」の下に1行追加と「値引」の上に1行追加と言うのは
>問題なくできたのですが、他の処理（今回のところで言うと
>次にある「式」の下（上）に1行追加）の場所では、
>挿入されません。
後半の部分については moriさんからもう少し具体的な説明が
あるまで回答を控えさせていただきます。
ところで、
ひとつ 重要なことを考慮していなかったので
その部分を修正したコードを投稿しておきます。
その部分とは １列目の転記が 「合計」か「値引」かの
条件のまえで実行されていたため、
他の列と同じ行に転記されていなかったことです。
以下に １列目も 条件節の中に入れたものを示します。
こちらのデバッグの都合上、また列の内容を理解しやすく
するため、変数を日本語などに変えていますのでご了承を。
Sub CreateMitsumori▲3()
Dim i As Long
Dim j As Long
Dim lngMaxRow As Long
Dim newLine As Long
Dim 行番号 As String
Dim 適用 As String
Dim 数量 As String
Dim 単位 As String
Dim 単価 As String
Dim 金額 As String
Dim Trim適用 As String '適用項目 トリミング後
With Worksheets(3)
'一時シートから行数を取得
lngMaxRow = Worksheets("TMP1").Cells(Rows.Count, 1) _
.End(xlUp).Row
j = 1
For i = 31 To lngMaxRow
If j = 1 Then
ElseIf j Mod 29 = 1 Then
'A列〜U列まで 29行をCopy
.Range("A4").Resize(29, 21).Copy .Cells(j + 3)
With .Cells(j + 3).Resize(29, 21)
.RowHeight = 27
Worksheets(3).PageSetup.PrintArea = .Cells
End With
End If
j = j + 1
Next
newLine = 4 '◆最初の貼り付け先行番号
For i = 31 To lngMaxRow
行番号 = Worksheets("TMP1").Cells(i, 1).Value
適用 = Worksheets("TMP1").Cells(i, 2).Value
数量 = Worksheets("TMP1").Cells(i, 3).Value
単位 = Worksheets("TMP1").Cells(i, 4).Value
単価 = Worksheets("TMP1").Cells(i, 5).Value
金額 = Worksheets("TMP1").Cells(i, 6).Value
'マイナス行番号を カッコ付き行番号にします
If 行番号 Like "-*" Then
行番号 = "'(" & Mid(行番号, 2) & ")"
End If
'文字列チェック
Trim適用 = Application.Trim(適用)
If InStr(Trim適用, "値引") Then '値引があれば
Trim適用 = "値引" '値引を抜き出します
End If
'転記開始
If Trim適用 = "合計" Then
'合計がある場合、小計欄のみに金額を挿入
.Cells(newLine, 1).Value = 行番号
.Cells(newLine, 2).Value = 適用
.Cells(newLine, 6).Value = 金額
newLine = newLine + 1 '◆前方空行挿入
ElseIf Trim適用 = "値引" Then
newLine = newLine + 1 '◆後方空行挿入
.Cells(newLine, 1).Value = 行番号
.Cells(newLine, 2).Value = 適用
.Cells(newLine, 6).Value = 金額
Else
.Cells(newLine, 1).Value = 行番号
.Cells(newLine, 2).Value = 適用
.Cells(newLine, 3).Value = 数量
.Cells(newLine, 4).Value = 単位
End If
newLine = newLine + 1 '◆次の転記行
Next
End With
End Sub
|
|
kanabun
- 09/6/17(水) 0:38 -
