- 310 名前：デフォルトの名無しさん mailto:sage [2022/08/10(水) 18:18:34.25 ID:kx7L/9BB0.net]
- >>308
挿入/削除はいろいろ面倒だから簡単にやるには別シート（もしくは別列）に転記しながら処理して最後に書き戻すのがわかりやすいと思う
スマホから入力してるから細かいミスはあると思うがこんな感じ
Dim S1 As WorkSheet: Set S1 = WorkSheets(1)
Dim S2 As WorkSheet: Set S2 = WorkSheets(2) ' 空のシート
Dim R1 As Long
Dim R2 As Long: R2 = 1
Dim N0 As Long: N0 = 0 ' 元の値合計
Dim N1 As Long: N1 = 0 ' 割戻し合計
Dim C0 As String ' 処理中のコード
C0 = S1.Cells(1, 1).Value
For R1 = 1 To S1.Cells(S1.Rows.Count, 1).End(xlUp).Row
Dim C1 As String ' 現在のコード
C1 = S1.Cells(R1, 1).Value
If C1 = "" Then Goto Continue
If C0 <> C1 Then
S2.Cells(R2, 1).Value = C0
S2.Cells(R2, 2).Value = "差額: " & CStr(N0 - N1)
R2 = R2 + 1
C0 = C1: N0 = 0: N1 = 0
End If
S2.Cells(R2, 1).Value = C1
Dim N2 As Long: N2 = S1.Cells(R1, 2).Value
S2.Cells(R2, 2).Value = N2
R2 = R2 + 1
N0 = N0 + N2: N1 = N1 + 0.9 * N2
Continue:
Next
S2.Cells(R2, 1).Value = C0
S2.Cells(R2, 2).Value = "差額: " & CStr(N0 - N1)
|
 |
