调整VBA宏以正确对齐Excel日记账分录的交易行

以下是修正后的VBA代码，解决了交易块识别不稳定、移位错误的问题，严格按照journal_id（列I）识别完整交易，并仅对需要移位的块操作：

Sub FixMisalignedJournalEntries()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentJournalRow As Long
    Dim nextJournalRow As Long
    Dim blockStart As Long, blockEnd As Long
    Dim shiftRows As Long
    
    ' 设置目标工作表，根据实际修改名称
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    
    currentJournalRow = 2 ' 假设第一行是表头，从第二行开始
    Do While currentJournalRow <= lastRow
        ' 确认当前行是交易起始点（列I非空）
        If ws.Cells(currentJournalRow, "I").Value <> "" Then
            blockStart = currentJournalRow
            ' 找到下一个journal_id的行，确定当前交易块的结束行
            nextJournalRow = currentJournalRow + 1
            Do While nextJournalRow <= lastRow And ws.Cells(nextJournalRow, "I").Value = ""
                nextJournalRow = nextJournalRow + 1
            Loop
            blockEnd = nextJournalRow - 1
            
            ' 判断是否需要移位：检查交易块首行上方是否存在可填充的空行
            shiftRows = 0
            Do While blockStart > 2 And ws.Cells(blockStart - 1, "I").Value = "" And ws.Cells(blockStart - 1, "A").Value = ""
                shiftRows = shiftRows + 1
                blockStart = blockStart - 1
            Loop
            
            ' 如果需要移位，移动整个交易块
            If shiftRows > 0 Then
                ws.Rows(blockStart + shiftRows & ":" & blockEnd + shiftRows).Cut
                ws.Rows(blockStart).Insert Shift:=xlDown
                Application.CutCopyMode = False
                ' 更新lastRow和currentJournalRow，避免跳过数据
                lastRow = lastRow - shiftRows
                currentJournalRow = blockStart + (blockEnd - (blockStart + shiftRows) + 1)
            Else
                ' 无需移位，直接跳到下一个交易块
                currentJournalRow = nextJournalRow
            End If
        Else
            ' 理论上不会走到这里，除非表头或空行混入，直接跳过
            currentJournalRow = currentJournalRow + 1
        End If
    Loop
    
    MsgBox "日记账错位修复完成！", vbInformation
End Sub

关键改进说明 #

• 精准交易块识别：从列I非空行出发，向下遍历直到下一个有journal_id的行，确保完整捕获同一交易的所有分录行，不会漏行或截断
• 错位判断逻辑：只在交易块首行上方存在连续空行时才执行移位，完全跳过已对齐的交易，避免误操作
• 安全移位操作：采用整行剪切-插入的方式移动整个交易块，确保关联行不会被误删或拆分，移位后自动更新行号索引，避免循环出错
• 边界处理：包含表头判断、数据末尾检测，避免越界运行

使用步骤 #

1. 打开你的日记账Excel文件
2. 按下Alt + F11打开VBA编辑器
3. 右键点击项目窗口中的目标工作表，选择「插入」→「模块」
4. 将上述代码粘贴到模块中，根据实际情况修改工作表名称（Sheet1）
5. 按下F5运行宏，或回到Excel界面通过「开发工具」→「宏」执行

内容的提问来源于stack exchange，提问作者Tariq Ahmed