一、公式获取列中最大值及所对应的行号

1. 获取区域最大值

excel">=MAX(IF(ROW(N:N)>3,N:N,""))

原理解析：

• ROW(N:N) - 返回行号
• IF(ROW(N:N)>3,N:N,"") - 过滤第3行之后的数据
• MAX() - 计算最大值

2. 查找最大值位置

excel">=MATCH(MAX(IF(ROW(O:O)>3,O:O,"")),IF(ROW(O:O)>3,O:O,""),0)

函数组合：

1. 内层：找出最大值
2. 外层：MATCH 函数定位最大值位置
3. 最后参数 0 表示精确匹配

3. 引用最大值对应单元格

excel">=INDEX(A:A,MATCH(MAX(IF(ROW(N:N)>3,N:N,"")),IF(ROW(N:N)>3,N:N,""),0))

函数链：

二、VBA 实现 Z 字形数据重排

1. 程序流程图

2. 核心代码解析

2.1 性能优化设置

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

2.2 工作表操作

' 删除已存在的工作表
On Error Resume Next
ThisWorkbook.Worksheets("Z排列结果").Delete
On Error GoTo 0' 创建新工作表
Set ws2 = ThisWorkbook.Worksheets.Add
ws2.Name = "Z排列结果"

2.3 数据复制循环

For i = 1 To lastCol Step 10colsToTransfer = Application.Min(10, lastCol - i + 1)' 复制三行数据ws1.Range(...).Copyws2.Cells(...).PasteSpecial xlPasteValuesnewRow = newRow + 3
Next i

2.4 页面设置

With ws2.PageSetup.Orientation = xlPortrait.PaperSize = xlPaperA4.FitToPagesWide = 1.PrintGridlines = True
End With

3. 关键技术要点

1. 错误处理：使用 On Error Resume Next 和 On Error GoTo 0
2. 性能优化：禁用屏幕刷新和自动计算
3. 循环控制：使用 Step 关键字控制步长
4. 页面布局：使用 PageSetup 对象设置打印格式

4. 实用技巧

1. 动态范围：

lastCol = ws1.Cells(3, ws1.Columns.Count).End(xlToLeft).Column

2. 分页处理：

For j = 10 To ws2.UsedRange.Columns.Count Step 10ws2.Columns(j).PageBreak = xlPageBreakManual
Next j

3. 自动列宽：

ws2.UsedRange.Columns.AutoFit

v20250210

Sub RearrangeRowsInZPatternWithPageSetup()Application.ScreenUpdating = FalseApplication.Calculation = xlCalculationManualApplication.EnableEvents = FalseDim ws1 As WorksheetDim ws2 As WorksheetDim lastCol As LongDim newRow As LongDim newCol As LongDim i As Long' 设置源工作表Set ws1 = ThisWorkbook.Worksheets("03.Obj Geom - Point Coordinates")' 创建新工作表On Error Resume NextThisWorkbook.Worksheets("Z排列结果").DeleteOn Error GoTo 0Set ws2 = ThisWorkbook.Worksheets.Addws2.Name = "Z排列结果"' 获取最后一列lastCol = ws1.Cells(3, ws1.Columns.Count).End(xlToLeft).Column' 初始化新位置计数器newRow = 1newCol = 1' 每10列为一组进行复制For i = 1 To lastCol Step 10' 确定当前组的列数Dim colsToTransfer As LongcolsToTransfer = Application.Min(10, lastCol - i + 1)' 直接复制值ws1.Range(ws1.Cells(3, i), ws1.Cells(3, i + colsToTransfer - 1)).Copyws2.Cells(newRow, newCol).PasteSpecial xlPasteValuesws1.Range(ws1.Cells(4, i), ws1.Cells(4, i + colsToTransfer - 1)).Copyws2.Cells(newRow + 1, newCol).PasteSpecial xlPasteValuesws1.Range(ws1.Cells(5, i), ws1.Cells(5, i + colsToTransfer - 1)).Copyws2.Cells(newRow + 2, newCol).PasteSpecial xlPasteValues' 更新行位置newRow = newRow + 3Next iApplication.CutCopyMode = False' 批量设置列宽ws2.UsedRange.Columns.AutoFit' 设置页面布局With ws2.PageSetup.Orientation = xlPortrait.PaperSize = xlPaperA4.LeftMargin = Application.CentimetersToPoints(2).RightMargin = Application.CentimetersToPoints(2).TopMargin = Application.CentimetersToPoints(2).BottomMargin = Application.CentimetersToPoints(2).FitToPagesTall = False.FitToPagesWide = 1.PrintGridlines = TrueEnd With' 批量添加分页符Dim j As LongFor j = 10 To ws2.UsedRange.Columns.Count Step 10ws2.Columns(j).PageBreak = xlPageBreakManualNext j' 设置视图ws2.Parent.Windows(1).View = xlPageBreakPreviewws2.Parent.Windows(1).Zoom = 120' 恢复Excel设置Application.ScreenUpdating = TrueApplication.Calculation = xlCalculationAutomaticApplication.EnableEvents = TrueMsgBox "finished", vbInformation
End Sub