[已解决][求助]127行后出错

zjsxzgx

 

不知什么地方出错了？

yW5zdWJS.rar (105.26 KB, 下载次数: 0)

2010-7-28 19:59 上传

点击文件名下载附件
127行后出错

[此贴子已经被作者于2010-7-29 6:45:14编辑过]

最佳答案

月排行榜 / 总排行榜

amulee

2010-7-29 14:33

计算精度问题

Sub d4()
    Application.ScreenUpdating = False
    Dim qishi As Long, jieshu As Long, K1 As String
    qishi = Range("n7").Row
    jieshu = Range("g7").End(xlDown).Row
    Range("P" & qishi & ":bi65536") = ""
    For qishi = qishi To jieshu

        If Range("G" & qishi) = "本月合计" Then
        m = qishi - 1
        i = Range("C" & m + 1).End(xlUp).Row
        Range("H" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*H$6:H" & i & ")")
        Range("J" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*J$6:J" & i & ")")
        ElseIf Range("G" & qishi) = "本年累计" Then
        n = qishi - 2
        Range("H" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*H$6:H" & n & ")")
        Range("J" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*J$6:J" & n & ")")
        End If

        Range("p" & qishi & ":u" & qishi) = Range("b" & qishi & ":g" & qishi).Value
        Range("ah" & qishi) = Range("i" & qishi)
        Range("au" & qishi) = Range("k" & qishi)
        Range("bh" & qishi) = Range("m" & qishi)

        If Range("h" & qishi) <> "" Then
            K1 = CStr(WorksheetFunction.Round(Range("h" & qishi) * 100, 0))
            For i = 1 To Len(K1)
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 33 - Len(K1) + i
                    Cells(qishi, f) = Mid(K1, i, 1)
                End If
            Next i
        End If

        If Range("j" & qishi) <> "" Then
            K1 = CStr(WorksheetFunction.Round(Range("j" & qishi) * 100, 0))
            For i = 1 To Len(K1)
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 46 - Len(K1) + i
                    Cells(qishi, f) = Mid(K1, i, 1)

                End If
            Next i
        End If

        If Range("l" & qishi) <> "" Then
            K1 = CStr(WorksheetFunction.Round(Range("l" & qishi) * 100, 0))
            For i = 1 To Len(K1)           '多次运算后这个地方LEN(K1) 始终是=4
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 59 - Len(K1) + i
                    Cells(qishi, f) = Mid(K1, i, 1)
                End If
            Next i
        End If
    Next qishi
    Range("N2") = qishi

    Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

上清宫主

你将k1定义为long,帮助说得很清楚：

Long 数据类型

请参阅     示例     特性

Long（长整型）变量存储为 32 位（4 个字节）有符号的数值形式，其范围从 -2,147,483,648 到 2,147,483,647。Long 的类型声明字符为和号 (&)。

zjsxzgx

Long  定义过，这样的话 LEN(K1) 始终 = 4 了

查不出原因

上清宫主

咋查不出原因呢？“Long（长整型）变量存储为 32 位（4 个字节）有符号的数值形式”这不是原因吗？

zjsxzgx

你的意思 dim k1 as long

zjsxzgx

顶上去，

amulee

Sub d4()
    Dim qishi As Long, jieshu As Long, K1 As String
    qishi = Range("n7").Row
    jieshu = Range("g7").End(xlDown).Row
    Range("P" & qishi & ":bi65536") = ""
    For qishi = qishi To jieshu

        If Range("G" & qishi) = "本月合计" Then
        m = qishi - 1
        i = Range("C" & m + 1).End(xlUp).Row
        Range("H" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*H$6:H" & i & ")")
        Range("J" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*J$6:J" & i & ")")
        ElseIf Range("G" & qishi) = "本年累计" Then
        n = qishi - 2
        Range("H" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*H$6:H" & n & ")")
        Range("J" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*J$6:J" & n & ")")
        End If

        Range("p" & qishi & ":u" & qishi) = Range("b" & qishi & ":g" & qishi).Value
        Range("ah" & qishi) = Range("i" & qishi)
        Range("au" & qishi) = Range("k" & qishi)
        Range("bh" & qishi) = Range("m" & qishi)

        If Range("h" & qishi) <> "" Then
            K1 = CStr(Range("h" & qishi) * 100)
            For i = 1 To Len(K1)
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 33 - Len(K1) + i
                    Cells(qishi, f) = Mid(K1, i, 1)
                End If
            Next i
        End If

        If Range("j" & qishi) <> "" Then
            K1 = CStr(Range("j" & qishi) * 100)
            For i = 1 To Len(K1)
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 46 - Len(K1) + i
                    Cells(qishi, f) = Mid(K1, i, 1)

                End If
            Next i
        End If

        If Range("l" & qishi) <> "" Then
            K1 = CStr(Range("l" & qishi) * 100)
            For i = 1 To Len(K1)           '多次运算后这个地方LEN(K1) 始终是=4
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 59 - Len(K1) + i
                    Cells(qishi, f) = Mid(K1, i, 1)
                End If
            Next i
        End If
    Next qishi
    Range("N2") = qishi

End Sub

zjsxzgx

俺使用您的代码

在127行还是错误。我纳闷的是在单元格J127以前有比88000大的数，也有比88000小的数。这些数都对了。为什么唯一这个错误。如果把J127改为 2000 所有的数据又都对了。包括J127以后的数值

希望高手们给个答案

[此贴子已经被作者于2010-7-29 14:12:14编辑过]

amulee

计算精度问题

Sub d4()
    Application.ScreenUpdating = False
    Dim qishi As Long, jieshu As Long, K1 As String
    qishi = Range("n7").Row
    jieshu = Range("g7").End(xlDown).Row
    Range("P" & qishi & ":bi65536") = ""
    For qishi = qishi To jieshu

        If Range("G" & qishi) = "本月合计" Then
        m = qishi - 1
        i = Range("C" & m + 1).End(xlUp).Row
        Range("H" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*H$6:H" & i & ")")
        Range("J" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*J$6:J" & i & ")")
        ElseIf Range("G" & qishi) = "本年累计" Then
        n = qishi - 2
        Range("H" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*H$6:H" & n & ")")
        Range("J" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*J$6:J" & n & ")")
        End If

        Range("p" & qishi & ":u" & qishi) = Range("b" & qishi & ":g" & qishi).Value
        Range("ah" & qishi) = Range("i" & qishi)
        Range("au" & qishi) = Range("k" & qishi)
        Range("bh" & qishi) = Range("m" & qishi)

        If Range("h" & qishi) <> "" Then
            K1 = CStr(WorksheetFunction.Round(Range("h" & qishi) * 100, 0))
            For i = 1 To Len(K1)
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 33 - Len(K1) + i
                    Cells(qishi, f) = Mid(K1, i, 1)
                End If
            Next i
        End If

        If Range("j" & qishi) <> "" Then
            K1 = CStr(WorksheetFunction.Round(Range("j" & qishi) * 100, 0))
            For i = 1 To Len(K1)
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 46 - Len(K1) + i
                    Cells(qishi, f) = Mid(K1, i, 1)

                End If
            Next i
        End If

        If Range("l" & qishi) <> "" Then
            K1 = CStr(WorksheetFunction.Round(Range("l" & qishi) * 100, 0))
            For i = 1 To Len(K1)           '多次运算后这个地方LEN(K1) 始终是=4
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 59 - Len(K1) + i
                    Cells(qishi, f) = Mid(K1, i, 1)
                End If
            Next i
        End If
    Next qishi
    Range("N2") = qishi

    Application.ScreenUpdating = True
End Sub

吕?布

好象是因为浮点计算的原因吧

 

Option Explicit

Sub d4()
    Dim lStart As Long
    Dim lEnd As Long
    Dim lLoop As Long
    Dim i As Long
    Dim m As Long, n As Long, f As Long
    Dim K1 As String
    
    lStart = Range("N2").Value            ' 起始
    lEnd = Range("G7").End(xlDown).Row    ' 结束
    Range("P" & lStart & ":BI65536").ClearContents
    'Range("P" & lStart & ":BI65536") = ""
    For lLoop = lStart To lEnd

        If Range("G" & lLoop) = "本月合计" Then
            m = lLoop - 1
            i = Range("C" & m + 1).End(xlUp).Row
            Range("H" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*H$6:H" & i & ")")
            Range("J" & m + 1) = Evaluate("SUMPRODUCT(($B$6:$B" & i & "=$B" & i & ")*J$6:J" & i & ")")
        ElseIf Range("G" & lLoop) = "本年累计" Then
            n = lLoop - 2
            Range("H" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*H$6:H" & n & ")")
            Range("J" & n + 2) = Evaluate("SUMPRODUCT(($B$6:$B" & n & ">0)*J$6:J" & n & ")")
        End If


        Range("P" & lLoop & ":U" & lLoop) = Range("B" & lLoop & ":G" & lLoop).Value
        Range("AH" & lLoop) = Range("I" & lLoop)
        Range("AU" & lLoop) = Range("K" & lLoop)
        Range("BH" & lLoop) = Range("M" & lLoop)

        ' 写入借方
        If Range("H" & lLoop) <> "" Then
            K1 = Format(Range("h" & lLoop) * 100, "0")
            For i = 1 To Len(K1)
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 33 - Len(K1) + i
                    Cells(lLoop, f) = Mid(K1, i, 1)
                End If
            Next i
        End If

        ' 写入贷方
        If Range("j" & lLoop) <> "" Then
            K1 = Format(Range("j" & lLoop) * 100, "0")
            For i = 1 To Len(K1)
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 46 - Len(K1) + i
                    Cells(lLoop, f) = Mid(K1, i, 1)

                End If
            Next i
        End If

        ' 写入余额
        If Range("l" & lLoop) <> "" Then
            K1 = Format(Range("l" & lLoop) * 100, "0")
            For i = 1 To Len(K1)           '多次运算后这个地方LEN(K1) 始终是=4
                If VBA.IsNumeric(Mid(K1, i, 1)) = True Then
                    f = 59 - Len(K1) + i
                    Cells(lLoop, f) = Mid(K1, i, 1)

                End If
            Next i
        End If
    Next lLoop
    Range("N2") = lStart


End Sub