Excel VBA宏单行列不转置及转置位置错误的修复请求

存在的问题 #

• 当仅存在1行需要转置的数据时，宏会跳过该行，无法完成转置操作
• 当前宏在检测完所有非数字行后的最后一行执行转置，需求是在包含数字的第一行位置进行转置

原代码 #

Sub transposeNumbers()
    Dim c As Range, LastRow As Long, TopN As Long, LastN As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For Each c In ActiveSheet.Range("A2:A" & LastRow)

    If IsNumeric(c.Offset(-1, 0)) = True Then
    
        TopN = c.Row
      
    Else
    
        If IsNumeric(c.Offset(1, 0)) = True Or c.Row = LastRow Then
        
            LastN = c.Row
            
            ActiveSheet.Range(ActiveSheet.Cells(TopN, 1), ActiveSheet.Cells(LastN, 1)).Copy
            c.Offset(0, 3).PasteSpecial Paste:=xlPasteAll, Transpose:=True
            Application.CutCopyMode = False
        
        End If
    
    End If

Next c

End Sub

问题分析 #

1. 单行转置失效：原逻辑依赖当前行上下行的数值状态标记转置范围，当只有一行数字时，没有符合的触发条件，导致转置被跳过。
2. 转置位置错误：原代码将转置结果粘贴在LastN行的D列（c.Offset(0,3)），不符合“在数字第一行位置转置”的需求。

修复后的代码 #

Sub transposeNumbersFixed()
    Dim c As Range, LastRow As Long, TopN As Long, LastN As Long
    Dim inNumberBlock As Boolean
    
    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    inNumberBlock = False
    
    For Each c In ActiveSheet.Range("A1:A" & LastRow)
        ' 标记数字块的起始行
        If IsNumeric(c.Value) And Not inNumberBlock Then
            TopN = c.Row
            inNumberBlock = True
        End If
        
        ' 标记数字块的结束行：当前行非数字且之前在数字块中，或者到最后一行
        If (Not IsNumeric(c.Value) And inNumberBlock) Or (c.Row = LastRow And inNumberBlock) Then
            LastN = IIf(c.Row = LastRow And IsNumeric(c.Value), c.Row, c.Row - 1)
            
            ' 复制数字块并转置到起始行的D列
            ActiveSheet.Range(Cells(TopN, 1), Cells(LastN, 1)).Copy
            Cells(TopN, 4).PasteSpecial Paste:=xlPasteAll, Transpose:=True
            Application.CutCopyMode = False
            
            inNumberBlock = False
        End If
    Next c
End Sub

修改说明 #

• 新增inNumberBlock变量跟踪是否处于数字行区域，解决单行数字无法识别的问题
• 调整数字块结束判断逻辑，确保单行数字也能触发转置
• 将粘贴目标改为Cells(TopN, 4)，直接在数字组第一行的D列粘贴转置结果
• 循环范围从A1开始，避免遗漏第一行是数字的情况

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