1234

ExcelHome技术论坛

用户名  找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

帖子
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 4110|回复: 14

[求助] 这个代码为什么下标越界啊,怎么找都找不到原因!!

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-9-17 23:47 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
Sub test()
Dim z, ar()
  z = Sheets.Count
  For x = 1 To z
  Erase ar()
With Sheets(x)
If .Name <> "打印表" Then
num = WorksheetFunction.CountIf(.[j:j], "Y")
If num = 0 Then
GoTo us
End If
ReDim ar(1 To num, 1 To 10)
arr = .Range("a1:j" & .Cells(Rows.Count, 1).End(xlUp).Row)
     For i = 1 To UBound(arr)
         If arr(i, 10) = "Y" Then
             N = N + 1
             For II = 1 To 10
                 ar(N, II) = arr(i, II)
             Next
         End If
     Next
Sheets("打印表").UsedRange.ClearContents
Sheets("打印表").[A1].Resize(UBound(ar), 10) = ar
Sheets("打印表").PrintPreview
End If
End With
us: Next x
End Sub
这个代码我怎么看都找不到原因,我都要疯了!为什么会下标越界啊!?
附件是运行这个代码的EXCEL

下标越界!!.rar

13.41 KB, 下载次数: 5

TA的精华主题

TA的得分主题

发表于 2018-9-18 05:08 来自手机 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
N没有重置,所以一直累加,肯定越界

TA的精华主题

TA的得分主题

发表于 2018-9-18 06:23 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
你的打印表在哪里?

TA的精华主题

TA的得分主题

发表于 2018-9-18 08:05 | 显示全部楼层
代码是要放在附件中测试的,单纯去看,很难看出问题的
另外在报错的时候,往往可以选择调试,然后看具体报错代码行,查看相关变量

目前楼主提供的附件中没有代码,具体表名跟代码中的表名也匹配不上,建议楼主再次缺了下

TA的精华主题

TA的得分主题

发表于 2018-9-18 08:16 | 显示全部楼层
原代码中主要是出现了“打印表”这个表不存在的问题导致
  1. Sub test()
  2.     Dim wPrn As Worksheet, wSH As Worksheet, rRNG As Range
  3.     Dim vData As Variant, nRow As Double, nCol As Integer
  4.     Dim vPrn As Variant, nPrn As Double
  5.    
  6.     On Error Resume Next
  7.     Set wPrn = Sheets("打印表")
  8.     If Err.Number = 0 Then
  9.         wPrn.Select
  10.     Else
  11.         Set wPrn = Sheets.Add(after:=Sheets(Sheets.Count))
  12.         wPrn.Name = "打印表"
  13.     End If
  14.     On Error GoTo 0
  15.    
  16.     For Each wSH In Sheets
  17.         With wSH
  18.             If .Name <> "打印表" Then
  19.                 Set rRNG = Nothing
  20.                 Set rRNG = .[J:J].Find(what:="Y", LookAt:=xlWhole)
  21.                 If Not rRNG Is Nothing Then
  22.                     vData = .[A1:J1].Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)
  23.                     ReDim vPrn(1 To 10, 1 To 11)
  24.                     nPrn = 0
  25.                     For nRow = 1 To UBound(vData)
  26.                         If vData(nRow, 10) = "Y" Then
  27.                             nPrn = nPrn + 1
  28.                             ReDim Preserve vPrn(1 To 10, 1 To nPrn)
  29.                             For nCol = 1 To 10
  30.                                 vPrn(nCol, nPrn) = vData(nRow, nCol)
  31.                             Next
  32.                         End If
  33.                     Next
  34.                     If nPrn > 0 Then
  35.                         With wPrn
  36.                             .UsedRange.ClearContents
  37.                             .[A1].Resize(nPrn, 10) = vPrn
  38.                             .PrintPreview
  39.                         End With
  40.                     End If
  41.                 End If
  42.             End If
  43.         End With
  44.     Next
  45. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2018-9-18 08:18 | 显示全部楼层
附上附件以供参考

下标越界!!(by.micro).rar

20.3 KB, 下载次数: 6

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-9-18 08:39 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
不好意思昨天太急了,这是修改后的附件,烦请各位帮帮忙!

下标越界修改!!.rar

23.81 KB, 下载次数: 6

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-9-18 08:40 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
lsc900707 发表于 2018-9-18 06:23
你的打印表在哪里?

不好意思,附件重新上传了,请帮忙看看谢谢了!

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-9-18 08:41 | 显示全部楼层
liulang0808 发表于 2018-9-18 08:05
代码是要放在附件中测试的,单纯去看,很难看出问题的
另外在报错的时候,往往可以选择调试,然后看具体报 ...

不好意思,附件重新上传了,请帮忙看看谢谢了!

TA的精华主题

TA的得分主题

发表于 2018-9-18 08:55 | 显示全部楼层
Sub test()
  Dim z, ar()
  z = Sheets.Count
  For x = 1 To z
      Erase ar()
        With Sheets(x)
            If .Name <> "打印表" Then
                num = WorksheetFunction.CountIf(.[j:j], "Y")
                If num = 0 Then
                    GoTo us
                End If
                ReDim ar(1 To num, 1 To 10)
                arr = .Range("a1:j" & .Cells(Rows.Count, 1).End(xlUp).Row)
                n = 0
                For i = 1 To UBound(arr)
                    If arr(i, 10) = "Y" Then
                        n = n + 1
                        For II = 1 To 10
                            ar(n, II) = arr(i, II)
                        Next
                    End If
                Next
                Sheets("打印表").UsedRange.ClearContents
                Sheets("打印表").[A1].Resize(UBound(ar), 10) = ar
                Sheets("打印表").PrintPreview
            End If
        End With
us:     Next x
End Sub
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

1234

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2025-1-22 20:12 , Processed in 0.028171 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表