用VBA实现日期段按单个条件查找某一列数据返回到其他工作表指定单元格区域内

雷雷爸

各位大神老师，目前这个工作簿在shiruiqiang老师的帮助下，基本上已经满足使用要求了，就是还有一点点不足的地方，就是超过返回的最大数据后，代码会报错，提示下标越界，如果能有提示框提示就好了，目前最多可以返回填充240个数据，因为表格最多可以填充248个，我想改成248个，还有就是两张工作表无法加密保护了，请问其他老师还有办法帮忙解决一下吗，万分感谢。

3190496160

查询条件是日期和强度等级，但是，
1、数据源中有三列是日期，究竟要根据哪一列的日期来查询？
2、目前数据源表的I列都是些错误值符号，
3、但是最多只能填充248个数据，如果超出的话，有没有办法解决或者提示等等，是什么意思？？

雷雷爸

3190496160 发表于 2023-6-2 08:36
查询条件是日期和强度等级，但是，
1、数据源中有三列是日期，究竟要根据哪一列的日期来查询？
2、目前数 ...

老师是根据工作表[试块强度输入]B列日期，不好意思之前没有表述清楚

3190496160

雷雷爸 发表于 2023-6-2 11:35
老师是根据工作表[试块强度输入]B列日期，不好意思之前没有表述清楚

真心求助就好好整理一下你的文件在上传呗，目前数据源表的I列都是些错误值符号，都没法测试代码的呀

雷雷爸

3190496160 发表于 2023-6-2 11:52
真心求助就好好整理一下你的文件在上传呗，目前数据源表的I列都是些错误值符号，都没法测试代码的呀

不好意思老师，我是小白，之前这个表格I列计算引用了一个vba自定义函数，我忘了删除了，现在应该可以看到了

shiruiqiang

表2的日期列cdate >=cdate（开始日期） and 日期列cdate <=cdate（结束日期）
表2的k列的值=强度等级选择
提取i列的值  
假如 i列的值<>""的话
n=n+1
brr（n\8,n mod 8）
如果n>248 提示后退出。
表有问题，以上解题思路

雷雷爸

shiruiqiang 发表于 2023-6-2 13:18
表2的日期列cdate >=cdate（开始日期） and 日期列cdate 248 提示后退出。
表有问题，以上解题思路

老师我表重新弄了一下，能帮忙写段代码吗？我是VBA小白

shiruiqiang

先记号一下。没别的老师的话，要傍晚有空才行

雷雷爸

shiruiqiang 发表于 2023-6-2 13:30
先记号一下。没别的老师的话，要傍晚有空才行

好的谢谢老师，我加了两个图片，根据日期范围和强度等级两个条件

shiruiqiang

Sub tiqu()
Dim x, m, n, j
Dim arr, brr(1 To 30, 1 To 8)
Dim starday, endday, qd
starday = Sheets("抗压强度评定").[o3]
endday = Sheets("抗压强度评定").[o4]
qd = Sheets("抗压强度评定").[p4]
arr = Sheets("试块强度输入").[a1].CurrentRegion
For x = 2 To UBound(arr)
If CDate(arr(x, 2)) >= CDate(starday) And CDate(arr(x, 2)) <= CDate(endday) Then
If arr(x, 11) = qd Then
If arr(x, 8) <> "" Then
n = n + 1
If n Mod 8 = 0 Then
j = (n \ 8)
m = 8
Else
j = (n \ 8) + 1
m = n Mod 8
End If
brr(j, m) = arr(x, 8)
End If
End If
End If
Next


Sheets("抗压强度评定").[e5:l35].ClearContents
If n > 240 Then
MsgBox "提取到符合的数值共:" & n & "个&#184;超出限定数量240个！"
Exit Sub
Else
Sheets("抗压强度评定").[e5].Resize(j, 8) = brr
End If



End Sub