| |
かみちゃん さん
何度も何度もありがとうございます。
取り急ぎ、全体を提示します。
Sub CreateMitsumori()
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim n As Long
Dim lngMaxRow As Long
Dim lngRow As Long
Dim blnFlag As Boolean
Dim lngCount As Long
Dim strName As String
Dim lngPresentRowIndex As Long
Dim lngRowX As Long
Dim lngRowY As Long
Dim strRangeValue As String
Dim lngFooterRowIndex As Long
Dim strGyoNO As String
Dim strTekiyo As String
Dim strSuryo As String
Dim strTani As String
Dim strTanka As String
Dim strKingaku As String
Dim strSyokei As String
Dim strKakkoGyoNO As String
Dim strKakkoKingaku As String
Dim strTrimedTekiyo As String 'トリミング後
Dim lngLength As Long
Dim lngTekiyoLength As Long
On Error GoTo Error_CreateMitsumori
With Worksheets(3)
'一時シートから行数を取得
lngMaxRow = Worksheets("TMP1").Range("A1").SpecialCells(xlLastCell).Row
blnFlag = False
j = 1
For i = 31 To lngMaxRow
If j = 1 Then
ElseIf j Mod 29 = 1 Then
.Range("A4:U32").Copy
lngRowY = j + 3
lngRowX = j + 31
strRangeValue = "A" & lngRowY & ":" & "U" & lngRowX
.Range(strRangeValue).PasteSpecial xlPasteAll
.Range(strRangeValue).RowHeight = 27
.PageSetup.PrintArea = .Range(strRangeValue)
End If
j = j + 1
Next
lngPresentRowIndex = 4
For lngRow = 31 To lngMaxRow
strGyoNO = Worksheets("TMP1").Cells(lngRow, 1).Value
strTekiyo = Worksheets("TMP1").Cells(lngRow, 2).Value
strSuryo = Worksheets("TMP1").Cells(lngRow, 3).Value
strTani = Worksheets("TMP1").Cells(lngRow, 4).Value
strTanka = Worksheets("TMP1").Cells(lngRow, 5).Value
strKingaku = Worksheets("TMP1").Cells(lngRow, 6).Value
strSyokei = Worksheets("TMP1").Cells(lngRow, 6).Value
'（）付行番号はCSV取込みすると−として認識されるので−を取り除きます
If Left(strGyoNO, 1) = "-" Then
lngLength = Len(strGyoNO)
strKakkoGyoNO = Mid(strGyoNO, 2, lngLength - 1)
strKakkoGyoNO = "'(" & strKakkoGyoNO & ")"
.Cells(lngPresentRowIndex, 1).Value = strKakkoGyoNO
Else
.Cells(lngPresentRowIndex, 1).Value = strGyoNO End If
'文字列チェック
strTrimedTekiyo = strTekiyo
strTrimedTekiyo = StrConv(strTrimedTekiyo, 4) '半角スペースがあった場合全角にします
strTrimedTekiyo = Replace(strTrimedTekiyo, " ", "") 'トリミングします
lngTekiyoLength = InStr(strTrimedTekiyo, "値引") '文字列"値引"の検索をし、文字位置を返します。無かった場合0を返します
If lngTekiyoLength > 0 Then
strTrimedTekiyo = Mid(strTrimedTekiyo, lngTekiyoLength, 2) '値引を抜き出します
End If
If strTrimedTekiyo = "合計" Then '合計がある場合、小計欄のみに金額を挿入
.Cells(lngPresentRowIndex, 2).Value = strTekiyo
.Cells(lngPresentRowIndex, 6).Value = strKingaku
ElseIf strTrimedTekiyo = "値引" Then
.Cells(lngPresentRowIndex, 2).Value = strTekiyo
.Cells(lngPresentRowIndex, 6).Value = strKingaku
Else
.Cells(lngPresentRowIndex, 2).Value = strTekiyo
.Cells(lngPresentRowIndex, 3).Value = strSuryo
.Cells(lngPresentRowIndex, 4).Value = strTani
lngPresentRowIndex = lngPresentRowIndex + 1 'インデックスを加算
Next
End With
Exit_CreateMitsumori:
Exit Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
