Each Next循环问题

白菜饺子

各位老师好，
我在使用Each Next循环表格出现了个问题。
这个表格的目的是循环现有的表格，然后把响应所需要的值放入汇表中，但是循环的时候出现了个问题，循环到一半就会出现错误类型了。
我看了一下，就是循环到空值的表格就过不去了。
麻烦各位老师帮忙看一下，谢谢~~

1. Sub sht()
   
2. Dim sht As Worksheet, i As String, j As Range
   
3.     i = 2
   
4.     For Each sht In Worksheets '历遍工作表
   
5.         For Each j In sht.Range("B2:AH85") '在工作表区域内历遍
   
6.             If j = "生产时间" Then '找到所需的关键字,以这个关键字为基点进行定位
   
7.                 Sheets("汇总").Range("a" & i) = j.Offset(0, 1).MergeArea.Cells(1, 1) '通过关键字（时间，品种，质量）坐标，将所需的数值汇总到汇总表中
   
8.                 Sheets("汇总").Range("b" & i) = j.Offset(0, 28).MergeArea.Cells(1, 1)
   
9.                 Sheets("汇总").Range("C" & i) = j.Offset(17, 1).MergeArea.Cells(1, 1)
   
10.                 i = i + 1 '一次循环行数加一
    
11.             End If
    
12.         Next j
    
13.     Next sht
    
14. End Sub
    

复制代码

测试记录表.zip (128.74 KB, 下载次数: 4)

2018-7-10 17:49 上传

点击文件名下载附件

⊙⊙小噤○

是单元格公式错误产生的

If j= "生产时间" Then
改成下面试试。
If j.Text = "生产时间" Then

或者屏蔽错误提示

1. On Error Resume Next

复制代码

jiangxiaoyun

用Find方法定位“生产时间”、、、

白菜饺子

⊙⊙小噤○ 发表于 2018-7-10 18:28
是单元格公式错误产生的

If j= "生产时间" Then

可以啦，谢谢你

白菜饺子

jiangxiaoyun 发表于 2018-7-10 18:31
用Find方法定位“生产时间”、、、

运行速度会快一点嘛，怎么搞呢~

白菜饺子

⊙⊙小噤○ 发表于 2018-7-10 18:28
是单元格公式错误产生的

If j= "生产时间" Then

老师，我还有个问题，按照这个生成的表格会出现把错误值也汇总进去的现象，能否有办法将错误数值的行删除或者不录入。
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
这个代码我复制进去，显示未定义

lsc900707

白菜饺子 发表于 2018-7-12 22:01
老师，我还有个问题，按照这个生成的表格会出现把错误值也汇总进去的现象，能否有办法将错误数值的行删除 ...

1. Sub gj23w98()
   
2.     Dim brr(1 To 10000, 1 To 3)
   
3.     For Each sht In Sheets
   
4.         If sht.Name <> ActiveSheet.Name Then
   
5.             With sht
   
6.                 arr = .UsedRange
   
7.                 For i = 1 To UBound(arr)
   
8.                    If arr(i, 1) = "生产时间" And Len(arr(i, 30)) Then
   
9.                        m = m + 1
   
10.                        brr(m, 1) = arr(i, 3)
    
11.                        brr(m, 2) = arr(i, 30)
    
12.                        brr(m, 3) = arr(i + 17, 2)
    
13.                    End If
    
14.                 Next
    
15.             End With
    
16.         End If
    
17.     Next
    
18.     If m Then
    
19.         [a1].CurrentRegion.Offset(1).ClearContents
    
20.         [a2].Resize(m, 3) = brr
    
21.     End If
    
22. End Sub
    

复制代码

lsc900707

代码需要审核，先传回附件供测试：

白菜饺子

lsc900707 发表于 2018-7-12 22:56
代码需要审核，先传回附件供测试：

谢谢老师！
虽然看不懂数组，不过解决了我的问题，而且运行起来好像比我原来写的更快了~
谢谢