一、公式获取列中最大值及所对应的行号
1. 获取区域最大值
=MAX(IF(ROW(N:N)>3,N:N,""))
原理解析:
ROW(N:N)
- 返回行号IF(ROW(N:N)>3,N:N,"")
- 过滤第3行之后的数据MAX()
- 计算最大值
2. 查找最大值位置
=MATCH(MAX(IF(ROW(O:O)>3,O:O,"")),IF(ROW(O:O)>3,O:O,""),0)
函数组合:
内层:找出最大值 外层:MATCH
函数定位最大值位置 最后参数 0
表示精确匹配
3. 引用最大值对应单元格
=INDEX(A:A,MATCH(MAX(IF(ROW(N:N)>3,N:N,"")),IF(ROW(N:N)>3,N:N,""),0))
函数链:
MAX 找最大值
MATCH 找位置
INDEX 返回引用
二、VBA 实现 Z 字形数据重排
1. 程序流程图
开始
禁用Excel自动更新
获取源数据范围
创建新工作表
按10列分组复制
设置页面格式
添加分页符
恢复Excel设置
结束
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. 关键技术要点
错误处理 :使用 On Error Resume Next
和 On Error GoTo 0
性能优化 :禁用屏幕刷新和自动计算循环控制 :使用 Step
关键字控制步长页面布局 :使用 PageSetup
对象设置打印格式
4. 实用技巧
动态范围 :
lastCol = ws1.Cells(3, ws1.Columns.Count).End(xlToLeft).Column
分页处理 :
For j = 10 To ws2.UsedRange.Columns.Count Step 10ws2.Columns(j).PageBreak = xlPageBreakManual
Next j
自动列宽 :
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 0 Set ws2 = ThisWorkbook. Worksheets. Addws2. Name = "Z排列结果" ' 获取最后一列lastCol = ws1. Cells ( 3 , ws1. Columns. Count) . End ( xlToLeft) . Column' 初始化新位置计数器newRow = 1 newCol = 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 + 3 Next 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 10 ws2. 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