修复Excel VBA转置宏仅支持2个及以上非数值项转置的问题

问题根因 #

原有代码的逻辑存在缺陷：当某行是连续非数值区域的第一行（上一行为数值）时，只会设置区域起始行TopN，不会同时判断当前行是否就是该连续区域的最后一行，因此连续非数值只有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
    ' 初始化起始行，避免首行就为非数值时变量未赋值报错
    TopN = 2
    
    For Each c In ActiveSheet.Range("A2:A" & LastRow)
        ' 仅处理非数值单元格，过滤数值行
        If Not IsNumeric(c.Value) Then
            ' 上一行为数值说明当前是连续非数值区域首行，更新起始行
            If IsNumeric(c.Offset(-1, 0)) = True Then
                TopN = c.Row
            End If
            
            ' 判断是否到达连续非数值区域末尾
            If c.Row = LastRow Or IsNumeric(c.Offset(1, 0)) = True Then
                LastN = c.Row
                ActiveSheet.Range(ActiveSheet.Cells(TopN, 1), ActiveSheet.Cells(LastN, 1)).Copy
                c.Offset(0, 2).PasteSpecial Paste:=xlPasteAll, Transpose:=True
                Application.CutCopyMode = False
            End If
        End If
    Next c
    
End Sub

核心修改点 #

• 新增当前单元格非数值判断，过滤不需要处理的数值行，逻辑更严谨
• 拆分原有If...Else结构，不管当前行是不是连续非数值的第一行，都会判断是否到达区域末尾，单条连续非数值的场景也能正常触发转置
• 补充TopN初始值，避免A列第2行就为非数值时变量未赋值的运行异常

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