求大神，帮忙看代码，明明数据都是两位小数的，会出现类似0.0100000000093132qingk...

yao5006

Sub test()
Dim s, d, i&, arr, arrPovit(), dic, k&, m&, n&, u, rng As Range
Dim sdate As Date
Set d = CreateObject("scripting.dictionary")
Set dic = CreateObject("scripting.dictionary")
arr = Array("30天以内", "30-60天", "60-180天", "180-360天", "1-2年", "2-3年", "3-4年", "4-5年", "5年以上")
s = Sheets("应收账款明细").Range("a1").CurrentRegion.Offset(1)
sdate = ThisWorkbook.Worksheets("帐龄分析").Range("k1").Value
For i = 1 To UBound(s) - 1
    Select Case sdate - s(i, 1)
        Case Is < 31: s(i, 1) = arr(0): Case 31 To 60: s(i, 1) = arr(1)
        Case 61 To 180: s(i, 1) = arr(2): Case 181 To 360: s(i, 1) = arr(3)
        Case 361 To 720: s(i, 1) = arr(4): Case 721 To 1080: s(i, 1) = arr(5)
        Case 1081 To 1440: s(i, 1) = arr(6): Case 1441 To 1800: s(i, 1) = arr(7)
        Case Is > 1800: s(i, 1) = arr(8)
    End Select
Next
ReDim arrPovit(1 To UBound(s), 1 To 11)
For i = 0 To UBound(arr)
    d(arr(i)) = i + 3
Next
For i = 1 To UBound(s) - 1
    If dic.exists(s(i, 8)) = True Then
        u = s(i, 7)
        arrPovit(dic(s(i, 8)), 2) = arrPovit(dic(s(i, 8)), 2) + s(i, 7)
        For m = 11 To 3 Step -1
            If u * arrPovit(dic(s(i, 8)), m) < 0 Then
                u = u + arrPovit(dic(s(i, 8)), m)
                If u * s(i, 7) > 0 Then
                arrPovit(dic(s(i, 8)), m) = 0
                ElseIf u * s(i, 7) <= 0 Then
                arrPovit(dic(s(i, 8)), m) = u
                GoTo Line
                End If
            End If
        Next m
        arrPovit(dic(s(i, 8)), d(s(i, 1))) = arrPovit(dic(s(i, 8)), d(s(i, 1))) + u
    Else
        k = k + 1: dic(s(i, 8)) = k: arrPovit(k, 1) = s(i, 8): arrPovit(k, 2) = s(i, 7): arrPovit(k, d(s(i, 1))) = s(i, 7)
    End If
Line: Next
ReDim s(1 To UBound(arrPovit), 1 To 11)
k = 0
For i = 1 To UBound(arrPovit)
If Abs(arrPovit(i, 2)) > 0.05 Then
    k = k + 1
    For m = 1 To 11
    s(k, m) = arrPovit(i, m)
    Next m
End If
Next i
With Sheets("帐龄分析")
.Range("4:65536").ClearContents
.Range("a2:b2") = Array("客户", "合计")
.Range("a3") = "合计"
.Range("c2").Resize(, 9) = arr
.Range("a4").Resize(k, 11) = s
    With .Range("b3")
        Set rng = .Parent.Range(.Offset(1), .Offset(1).End(xlDown))
        .Formula = "=sum(" & rng.Address(False, False) & ")"
        .Copy Destination:=.Parent.Range("c3:k3")
    End With
.Range("a:k").EntireColumn.AutoFit
.Cells.Borders.LineStyle = xlLineStyleNone
    With .Range("a2").CurrentRegion
    .Borders.LineStyle = xlDash
    .Borders.Weight = xlHairline
    .BorderAround Weight:=xlMedium
    End With
  .Range("a3:k3").Borders(xlEdgeBottom).LineStyle = xlDouble
End With
End Sub

wb_1027

这是从哪里抄来的账龄分析，，，

yao5006

wb_1027 发表于 2024-4-18 17:34
这是从哪里抄来的账龄分析，，，

也是在论坛找到，改了改

鄂龙蒙

发附件上来，才好帮您测试找原因

wcj6376tcp

加个round函数不就OK