修改计算代码

lufabao7788

Private Sub 提成窗体_Click()
If ComboBox1 = "" Then
    MsgBox "活动名称 不能为空"
    Exit Sub
End If
sName = ComboBox1          '实例名=
On Error Resume Next          '在错误恢复下

    Set d = CreateObject("scripting.dictionary")
    With Sheets(sName + "会员缴费表")
        r = .Cells(.Rows.Count, 13).End(3).Row
        arr = .Range("a8:p" & r)
    End With
    ReDim brr(1 To UBound(arr), 1 To 9)
    For x = 1 To UBound(arr)
           s = arr(x, 13)
        If d(s) = "" Then
            k = k + 1: d(s) = k
            brr(k, 1) = s
            brr(k, 2) = arr(x, 11)
            brr(k, 3) = arr(x, 7)
            For j = 4 To 6
                brr(k, j) = arr(x, j + 10)
            Next
        Else
            brr(d(s), 2) = arr(x, 11) + brr(d(s), 2)
            brr(d(s), 3) = arr(x, 7) + brr(d(s), 3)
            For j = 4 To 5
                brr(d(s), j) = arr(x, j + 10) + brr(d(s), j)
            Next
            brr(d(s), 6) = brr(d(s), 3) - brr(d(s), 4) - brr(d(s), 5)
        End If
    Next

    With Sheets("单条件多列汇总")
    .[a1,a2,d2,i3] = ""
    .Range("a5:i65536").Clear
        .[a5].Resize(k, 6) = brr

''@@@@@@@@下面两句代码放到上面的循环里
  .Range("g5:g10") = "10%"
.Range("h5") = .Range("f5") * .Range("g5")

.Range("A1") = Sheets(sName & "会员缴费表").Range("A1")
.Range("A2") = Sheets(sName & "会员缴费表").Range("A2")
.Range("d2") = Sheets(sName & "会员缴费表").Range("I2")
   End With

Dim rng1 As Range
For Each rng1 In Range("a5:i10000")
    If rng1 <> "" Then
        Range(Cells(rng1.Row, rng1.Column + 0), Cells(rng1.Row, "i")).Borders.LineStyle = 1
    End If
Next rng1

End Sub

lufabao7788

请各位高人帮忙

lufabao7788

有老师在吗？

lufabao7788

帖子再往前提提，等待老师门修改