sub **()
end sub
1.部分がコピペにより二重になってる
2.シート名、セル配置が違う
ってことはないですか?
コードについては独学なのでぶきっちょな出来ですが…
まず、転記マクロを実行して項目類を別シートに転記
その後計算をさせるマクロを実行します。
Sub 計算()
Dim i As Integer, j As Integer
Dim co1 As Integer
Dim temp As Integer
Dim 項目数 As Integer
Dim kin As Long, kkin As Long
With Sheets("計算書")
'計算範囲をクリアしとく(適当に1000行まで)
.Range("h2", "j100").ClearContents
項目数 = Sheets("元データ").Range("c1") - 1
co1 = .Range("b65536").End(xlUp).Row + 1
temp = 0
kin = 0
kkin = 0
'データ数だけ繰り返す
For i = 2 To co1
'B列が空白でなかったら以下の処理
If .Range("b" & i) <> "" Then
'手数料の種類だけ繰り返す
kin = kin + .Range("c" & i)
For j = 4 To 7
'対象のセルのカラーが薄い水色だったら小切手としてI列に表示
If .Cells(i, j).Interior.ColorIndex = 34 Then
.Range("i" & i) = .Cells(i, j)
kkin = kkin + .Cells(i, j) '小切手の金額を合算しておく
End If
'対象のセルが太文字だったら手数料は当社負担として請求合計に合算
If .Cells(i, j).Font.Bold = True Then
kin = kin + .Cells(i, j)
Else
'そうでない場合は手数料は先方負担として請求合計から引く
kin = kin - .Cells(i, j)
End If
'項目数とtempが同数になったらkinを表示
If 項目数 = temp Then
.Range("H" & i) = kin
temp = -1
.Range("j" & i) = kin - kkin
kin = 0 'kinをリセット
kkin = 0
End If
Sub 転記のマクロ()
'元シートから転記するマクロだお(=゚ω゚)ノ
'****宣言しまっす*****
Dim i As Integer, j As Integer
Dim co1 As Integer, co2 As Integer '行データ数
Dim cor1 As Integer, cor2 As Integer 'データ列数
Dim ksh As Worksheet
'元シートを元データとして名前を省略させます
With Sheets("元データ")
'計算シートをkshと短縮登録するお(=゚ω゚)ノ
Set ksh = Sheets("計算書")