[已解决]自动汇总数据-不显示运费为0的行,求解决

bfs1981

VBA-自动汇总数据-不显示运费为0的行.zip (24.12 KB, 下载次数: 10)

2014-11-28 22:47 上传

点击文件名下载附件
要求运费为0时，所在行不显示
另一个要求，帮帮忙，把VBA程序结构用途标注一下，我好理解一下，谢谢了

最佳答案

月排行榜 / 总排行榜

dsmch

2014-11-29 10:04

Private Sub Worksheet_Change(ByVal Target As Range)   
If Target.Address(0, 0) = "B6" Then
        With Sheets("数据源")
            ROW1 = .Range("A" & .Rows.Count).End(xlUp).Row
            ARR1 = .Range("A2:R" & ROW1)
        End With
        If ROW1 > 1 Then
            ReDim ARR11(1 To UBound(ARR1), 1 To 8)
            For I = 1 To UBound(ARR1)
                If ARR1(I, 7) = Target.Value And ARR1(I, 13) <> 0 Then
                    N = N + 1
                    ARR11(N, 1) = N
                    ARR11(N, 2) = Year(Now()) & "-" & ARR1(I, 2)
                    ARR11(N, 3) = ARR1(I, 3)
                    ARR11(N, 4) = ARR1(I, 8)
                    ARR11(N, 5) = ARR1(I, 9)
                    ARR11(N, 6) = ARR1(I, 15)
                    ARR11(N, 7) = ARR1(I, 13)
                    ARR11(N, 8) = ARR1(I, 16)
                    QTFY = QTFY + ARR11(N, 6)
                    ZZL = ZZL + ARR11(N, 5)
                    YF = YF + ARR11(N, 7)
                    HJ = HJ + ARR11(N, 6) + ARR11(N, 7)
                End If
            Next I
            With Sheets("想要的示例A")
                If N > 0 Then
                    .Range("A8:H8").ClearContents
                    .Range("A9:H" & .Rows.Count).Clear
                    .Range("A8").Resize(N, 8) = ARR11
                    If N > 1 Then
                        .Range("A8:H8").Copy
                        .Range("A9:H" & 8 + N - 1).Select
                        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                                               SkipBlanks:=False, Transpose:=False
                        Application.CutCopyMode = False
                    End If
                    .Range("B" & 8 + N) = "其它费用:"
                    .Range("D" & 8 + N) = "总重量："
                    .Range("B" & 8 + N + 1) = "运费:"
                    .Range("B" & 8 + N + 2) = "TOTAL:"
                    .Range("C" & 8 + N) = QTFY
                    .Range("E" & 8 + N) = ZZL
                    .Range("C" & 8 + N + 1) = YF
                    .Range("C" & 8 + N + 2) = HJ
                    .Range("C" & 8 + N + 2).Select
                Else
                    .Range("A8:H8").ClearContents
                    .Range("A9:H" & .Rows.Count).Clear
                End If
            End With
        End If
    End If
End Sub

跳转到最佳答案楼层

dsmch

Private Sub Worksheet_Change(ByVal Target As Range)   
If Target.Address(0, 0) = "B6" Then
        With Sheets("数据源")
            ROW1 = .Range("A" & .Rows.Count).End(xlUp).Row
            ARR1 = .Range("A2:R" & ROW1)
        End With
        If ROW1 > 1 Then
            ReDim ARR11(1 To UBound(ARR1), 1 To 8)
            For I = 1 To UBound(ARR1)
                If ARR1(I, 7) = Target.Value And ARR1(I, 13) <> 0 Then
                    N = N + 1
                    ARR11(N, 1) = N
                    ARR11(N, 2) = Year(Now()) & "-" & ARR1(I, 2)
                    ARR11(N, 3) = ARR1(I, 3)
                    ARR11(N, 4) = ARR1(I, 8)
                    ARR11(N, 5) = ARR1(I, 9)
                    ARR11(N, 6) = ARR1(I, 15)
                    ARR11(N, 7) = ARR1(I, 13)
                    ARR11(N, 8) = ARR1(I, 16)
                    QTFY = QTFY + ARR11(N, 6)
                    ZZL = ZZL + ARR11(N, 5)
                    YF = YF + ARR11(N, 7)
                    HJ = HJ + ARR11(N, 6) + ARR11(N, 7)
                End If
            Next I
            With Sheets("想要的示例A")
                If N > 0 Then
                    .Range("A8:H8").ClearContents
                    .Range("A9:H" & .Rows.Count).Clear
                    .Range("A8").Resize(N, 8) = ARR11
                    If N > 1 Then
                        .Range("A8:H8").Copy
                        .Range("A9:H" & 8 + N - 1).Select
                        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                                               SkipBlanks:=False, Transpose:=False
                        Application.CutCopyMode = False
                    End If
                    .Range("B" & 8 + N) = "其它费用:"
                    .Range("D" & 8 + N) = "总重量："
                    .Range("B" & 8 + N + 1) = "运费:"
                    .Range("B" & 8 + N + 2) = "TOTAL:"
                    .Range("C" & 8 + N) = QTFY
                    .Range("E" & 8 + N) = ZZL
                    .Range("C" & 8 + N + 1) = YF
                    .Range("C" & 8 + N + 2) = HJ
                    .Range("C" & 8 + N + 2).Select
                Else
                    .Range("A8:H8").ClearContents
                    .Range("A9:H" & .Rows.Count).Clear
                End If
            End With
        End If
    End If
End Sub

bfs1981

dsmch 发表于 2014-11-29 10:04
Private Sub Worksheet_Change(ByVal Target As Range)   
If Target.Address(0, 0) = "B6" Then
        ...

大侠，能改变“运费”，“其它运费”，“总重量”，“TOTAL”的字体，大小，或者加个下划线吗