麻烦哪位大师用VBA帮我改进一下

缘来是朋友

麻烦哪位大师用VBA,帮我写一下，谢谢！！！就是借方减贷方余额，不停地往下计算并将结果显示在对应L列，没数据就停止计算

dgerwin

用公式可以处理，一定要用VBA？

dgerwin

用公式可以处理，一定要用VBA？
改进，现在的余额是VBA算出来的？

zxmg2009

你这个要标明余额的借贷方向，否则看不懂余额

缘来是朋友

麻烦大家了，多谢！！！

缘来是朋友

dgerwin 发表于 2020-3-28 23:40
用公式可以处理，一定要用VBA？
改进，现在的余额是VBA算出来的？

现在就是用公式处理的！！

缘来是朋友

zxmg2009 发表于 2020-3-29 09:24
你这个要标明余额的借贷方向，否则看不懂余额

负数就是贷方余额了！！

dgerwin

现在複製粘贴自已以前编的一大堆垃圾到下面,
其中有一行代码是计算余额的。这个代码的用途：根据输入的会计科目代码，根据年初余额及凭证，生成明细账。

If Target.Row = 2 And Target.Column = 7 Then
   

pzend = Sheet3.Range("E2").End(xlDown).Row
subNo = Trim(CStr(Sheet8.Range("g2").Value))
On Error Resume Next
kmin = Application.WorksheetFunction.VLookup(subNo, Sheet2.Range("A2:F" & Sheet9.Range("E4").Value), 6, 0)

arr1 = Sheet3.Range("b3:J" & pzend).Value
j = 0

pginl = Sheet8.Range("g1").Value

pgn = Int(j / pginl) + 1
Sheet8.Select
'Sheet8.Range("A9:I15000").ClearContents
Sheet8.Range("A9:I15000").Clear
Sheet8.Range("A9:I15000").Font.Size = 12
'Sheet8.Range("a9:i15000").PageBreak = xlPageBreakNone

Sheet8.Range(Cells(8, 2), Cells(9 + pginl, 8)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With





With Sheet8
       If (j Mod pginl) = 0 Then
        .Cells(j + pgn * 8, 2).Value = "  月 "
         .Cells(j + pgn * 8, 2).Value = "  月 "
         .Cells(j + pgn * 8, 2).Value = "  月 "
       .Cells(j + pgn * 8, 2).Value = "  月 "
       .Cells(j + pgn * 8, 3).Value = " 凭证号"
       .Cells(j + pgn * 8, 4).Value = "  摘要 "
       .Cells(j + pgn * 8, 5).Value = "借方金额 "
       .Cells(j + pgn * 8, 6).Value = "  贷方金额 "
       .Cells(j + pgn * 8, 7).Value = "  余额  "
       .Cells(j + pgn * 8, 8).Value = "核对"
      
       End If
End With
If kmin <> 0 Then
   
    Sheet8.Range("D9").Value = "上年结转"
    Sheet8.Range("G9").Value = kmin
    kmye = kmin
    j = 2
    Else
    j = 1
    kmye = 0
    End If

For i = 1 To pzend - 2
    If arr1(i, 4) = subNo Then
   
       With Sheet8
      
            
       .Cells(j + pgn * 8, 2).Value = arr1(i, 1)
       .Cells(j + pgn * 8, 3).Value = arr1(i, 2)
       .Cells(j + pgn * 8, 4).Value = arr1(i, 3)
       .Cells(j + pgn * 8, 5).Value = arr1(i, 8)
       .Cells(j + pgn * 8, 6).Value = arr1(i, 9)
         kmye = kmye + arr1(i, 8) - arr1(i, 9)    '计算余额
       .Cells(j + pgn * 8, 7).Value = kmye
        
      
       If (j Mod pginl) = 0 Then
        .Cells(j + pgn * 8 + 1, 4).Value = " 转 下 页 "
         End If
         j = j + 1
          pgn = Int((j - 1) / pginl) + 1
         
         
         If ((j - 1) Mod pginl) = 0 Then
         '.HPageBreaks.Creator
       '  .HPageBreaks.Add (.Cells(j + pgn * 8 - 6, 4))
         .Cells(j + pgn * 8 - 4, 4).Value = .Cells(6, 4).Value
         .Cells(j + pgn * 8 - 4, 4).Font.Size = 16
           .Cells(j + pgn * 8 - 3, 2).Value = .Cells(7, 2).Value
       .Cells(j + pgn * 8 - 3, 4).Value = .Cells(7, 4).Value
       .Cells(j + pgn * 8 - 4, 7).Value = .Cells(6, 7).Value
       .Cells(j + pgn * 8 - 3, 7).Value = "页数：第" & pgn & "页"
            
         
       .Cells(j + pgn * 8 - 2, 2).Value = "  月 "
       .Cells(j + pgn * 8 - 2, 3).Value = " 凭证号"
       .Cells(j + pgn * 8 - 2, 4).Value = "  摘要 "
       .Cells(j + pgn * 8 - 2, 5).Value = "借方金额 "
       .Cells(j + pgn * 8 - 2, 6).Value = "  贷方金额 "
       .Cells(j + pgn * 8 - 2, 7).Value = "  余额  "
       .Cells(j + pgn * 8 - 2, 8).Value = "核对"
        .Cells(j + pgn * 8 - 1, 4).Value = " 承上页 "
        .Cells(j + pgn * 8 - 1, 7).Value = kmye
        
        .Range(Cells(j + pgn * 8 - 2, 2), Cells(j + pgn * 8 + pginl, 8)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
      
               
        End If
      
         
      
      
    End With
    End If


Next i


With Sheet8

     .Range("c7:c1500").NumberFormatLocal = "##"
     .Range("E9:F" & .Range("G65535").End(xlUp).Row).NumberFormatLocal = "#,##0.00"
      .Range("G9:G" & .Range("G65535").End(xlUp).Row).NumberFormatLocal = """借  ""#,##0.00;""贷  ""##,##0.00;""平"""
End With

Sheet8.Range("f6").Select
End If

End Sub

dgerwin

都说过是一大堆垃圾,只有其中几行可以参照，不可以照搬来用。

你查看一下新手必读，
在文件中提出要求,解释什么情况下计余额什么情况下不计余额，然后压缩上传.

用一行公式，还是用一大堆代码，我宁愿选择前者。