| |
▼mori さん：
>概要としては、行番号の（）は'を付けて文字列扱いにする。
>単位欄に「式」・単価欄がブランクであれば、上に1行挿入する。
>合計欄の下に1行挿入する。
>その他の文字などはそのまま入力する。
>です。
シートのレイアウトが出てきたのでずいぶん分かりやすくなりましたね(^^
それなら、こうしたらどうですか？
Else のなかに
もうひとつ If文をおいて、そこに
>単位欄に「式」・単価欄がブランクであれば、上に1行挿入する。
特別処理を挿入しておく。
Sub CreateMitsumori▲5()
Dim i As Long
Dim j As Long
Dim lngMaxRow As Long
Dim newLine As Long
Dim str行番号 As String
Dim str適用 As String
Dim str数量 As String
Dim str単位 As String
Dim str単価 As String
Dim str金額 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
str行番号 = Worksheets("TMP1").Cells(i, 1).Value
str適用 = Worksheets("TMP1").Cells(i, 2).Value
str数量 = Worksheets("TMP1").Cells(i, 3).Value
str単位 = Worksheets("TMP1").Cells(i, 4).Value
str単価 = Worksheets("TMP1").Cells(i, 5).Value
str金額 = Worksheets("TMP1").Cells(i, 6).Value
'転記開始
'行番号欄に記載のあったとき
If Len(str行番号) > 0 Then
'マイナス行番号を カッコ付き行番号にします
If str行番号 Like "-*" Then
str行番号 = "'(" & Mid(str行番号, 2) & ")"
End If
.Cells(newLine, 1).Value = str行番号
End If
'摘要欄の文字列チェック
Trim適用 = Application.Trim(str適用)
If InStr(Trim適用, "値引") Then '値引があれば
Trim適用 = "値引" '値引を抜き出します
End If
If Trim適用 = "合計" Then
.Cells(newLine, 2).Value = str適用 '合計
.Cells(newLine, 6).Value = str金額
newLine = newLine + 1 '◆下に空行挿入
ElseIf Trim適用 = "値引" Then
newLine = newLine + 1 '◆上に空行挿入
.Cells(newLine, 2).Value = str適用
.Cells(newLine, 6).Value = str金額
Else
'---------------------------------------------- 挿入
'単位欄が「式」で 単価欄に記載がないときは
If str単位 = "式" And str単価 = "" Then
newLine = newLine + 1 '◆上に空行挿入
End If
'---------------------------------------------------
.Cells(newLine, 2).Value = str適用
.Cells(newLine, 3).Value = str数量
.Cells(newLine, 4).Value = str単位
.Cells(newLine, 5).Value = str単価
.Cells(newLine, 6).Value = str金額
End If
newLine = newLine + 1 '◆次の転記行
Next
End With
End Sub
あいかわらず、検証してませんので、不具合があれば
ご指摘ください。
|
|
kanabun
- 09/6/17(水) 14:18 -
