ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何用VBA自定义数组分页函数?

如何用VBA自定义数组分页函数?

作者:绿色风 分类: 时间:2022-08-17 浏览:97
楼主
DJ_Soo
Q: 如何用VBA自定义数组分页函数?
因为工作中经常需要对所选数据区域进行分页,现在本人做了一个关于数组的分页函数,个人觉得比较通用,特意贴出来给大家分享一下。
A:ALT+F11→插入模块→在模块中输入下面代码:
  1. Function PageForArr(arr As Variant, pLine As Long, Page As Integer) As Variant
  2.     Dim lstLine As Long
  3.     Dim Line As Long
  4.     Dim Ro As Long
  5.     Dim lstCol As Byte
  6.     Dim Col As Byte
  7.     Dim arrTmp() As String
  8.     lstLine = UBound(arr, 1)
  9.     If pLine >= lstLine Then
  10.         'MsgBox "此数据只有一页!", vbInformation, "提示:"
  11.         PageForArr = arr                                    '如果只有一页,则直接赋值
  12.     Else
  13.         lstCol = UBound(arr, 2)
  14.         ReDim arrTmp(1 To pLine, 1 To lstCol)
  15.         For Line = (Page - 1) * pLine + 1 To Page * pLine   '判断起始位置
  16.             Ro = Ro + 1
  17.             For Col = 1 To lstCol
  18.                 arrTmp(Ro, Col) = arr(Line, Col)
  19.             Next Col
  20.             If Line = lstLine Then Exit For                 '如果读取了最后一条数据,结束循环
  21.         Next Line
  22.         PageForArr = arrTmp
  23.     End If
  24. End Function

自定义函数说明:arr为源数据(二维数组),用此源数据制作分页;
而pLine为每一页的行数(可根据需要自己定义);
Page为想要显示的页码。
测试代码:
  1. Sub Test()
  2.     Const pLine As Long = 5
  3.     Dim Page As Integer
  4.     Dim arrRaw As Variant
  5.     With ThisWorkbook
  6.         Page = .Sheets(1).[B1]
  7.         arrRaw = .Sheets(2).UsedRange
  8.         .Sheets(1).[A3:I7] = PageForArr(arrRaw, pLine, Page)
  9.     End With
  10. End Sub

Sheet1事件触发代码:
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If Target.Address = [B1].Address Then Call Test
  3. End Sub



 
自定义函数:数组分页.rar
2楼
hhzjxss
谢谢分享,下载看看!
3楼
冷梅
很想学会 但是有不明白的地方 希望指教 QQ170270317

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap