求助VBA转自定义函数

jonn

VBA 代码已经通过测试成功，但我个人水平有限 无法编成自定义函数，请各位大神帮忙谢谢。
自定义函数的目标是从一个代码和日期 来判断数据库中 该代码的日前是否在日期1和日期2的范围内，详细请看附件。
我的思路：
1、取得代码A5在DATA表O列数据中出现次数
2、取得A5代码在DATA表O列出现第一个数字的行数
3、如果代码A5出现次数为0，则返回该表B列数值
如果出现次数不为0，则从DATA表第一个行数开始判断，判断到第一行加次数-1(16+4-1)为止，日期是否在日期1和日期2的范围内，如在范围内 则返回日期1的前1天日期，否则返回该表B列数值


测试代码如下： 代码中的MSGBOX N  理论上改为函数名称赋值即可（如 ALV = N） ，但由于里面的各个参数我没搞懂，一直没成功。

Sub ALV22()


Dim M As Variant, N As Variant, X1 As Range, X2 As Variant, X3 As Variant

M = "000018.SZ"  'A列数值赋值
N = 43133       'B列日期赋值
X2 = 17        '日期1所在列的列号
X3 = 18      '日期2所在列的列号

'判断列在 DATA数据表的O列，在下面代码中体现
'MsgBox Range("o:o").Column

Dim ii As Integer, ii1 As Integer
On Error Resume Next
ii = Application.WorksheetFunction.CountIf(Range("O:O"), M) '通过函数判断数量，如果数量为0 则退出
   If ii = 0 Then
   MsgBox N
   Exit Sub
   End If

ii1 = Application.WorksheetFunction.Match(M, Range("O:O"), 0)  '通过函数找到最接近的行数
'MsgBox ii1

If Application.WorksheetFunction.IsNumber(ii1) Then
If ii1 = 0 Then
   MsgBox N
   Exit Sub
End If

'日期范围内判断 取日期1前1天日期
For i = ii1 To ii1 + ii - 1
   If N >= Cells(i, X2) And N < Cells(i, X3) Then
     If Cells(i + 1, X3) <> Cells(i, X2) Then
       MsgBox Cells(i, X2) - 1
     Else
     MsgBox Cells(i + 1, X2) - 1
     End If
   Exit Sub
   End If
Next i

MsgBox N
End If
End Sub


'以下为自定义函数的命令框架
Function ALV(M As Variant, N As Variant, X1 As Range, X2 As Variant, X3 As Variant)
'五个参数  M为代码参数  N为日期参数  X1位代码 列数据范围   X2为数据库日期列数据范围  X3为数据库日期2 列数据范围

End Function


再次感谢各位大神出手帮助！！

自定义函数需求.rar (155.94 KB, 下载次数: 5)

2018-6-10 18:37 上传

点击文件名下载附件

opiona

1. Sub TEST()
   
2.     Dim M As Variant, N As Variant, X1 As Range, X2 As Variant, X3 As Variant
   
3.     M = "000018.SZ"  'A列数值赋值
   
4.     N = 43133       'B列日期赋值
   
5.     X2 = 17        '日期1所在列的列号
   
6.     X3 = 18      '日期2所在列的列号
   
7.     Rem  没发现X1 被用到 何处了
   
8.     MsgBox ALV(M, N, X1, X2, X3)
   
9. End Sub
   
10. 
    
11. Function ALV(M As Variant, N As Variant, X1 As Range, X2 As Variant, X3 As Variant) As Variant
    
12.    Rem 五个参数  M为代码参数  N为日期参数  X1位代码 列数据范围   X2为数据库日期列数据范围  X3为数据库日期2 列数据范围
    
13.     Dim ii As Integer, ii1 As Integer
    
14.     On Error Resume Next
    
15.     ii = Application.WorksheetFunction.CountIf(Range("O:O"), M) '通过函数判断数量，如果数量为0 则退出
    
16.     If ii = 0 Then
    
17.         ALV = N
    
18.         Exit Function
    
19.     End If
    
20.     ii1 = Application.WorksheetFunction.Match(M, Range("O:O"), 0)  '通过函数找到最接近的行数
    
21.     If Application.WorksheetFunction.IsNumber(ii1) Then
    
22.         If ii1 = 0 Then
    
23.             ALV = N
    
24.             Exit Function
    
25.         End If
    
26. 
    
27.         '日期范围内判断 取日期1前1天日期
    
28.         For i = ii1 To ii1 + ii - 1
    
29.             If N >= Cells(i, X2) And N < Cells(i, X3) Then
    
30.                 If Cells(i + 1, X3) <> Cells(i, X2) Then
    
31.                     ALV = Cells(i, X2) - 1
    
32.                 Else
    
33.                     ALV = Cells(i + 1, X2) - 1
    
34.                 End If
    
35.                 Exit Function
    
36.             End If
    
37.         Next i
    
38.         ALV = N
    
39.         Exit Function
    
40.     End If
    
41. End Function

复制代码

opiona

其他请参考：关于自定义函数的使用理解及函数集锦

http://club.excelhome.net/thread-1279693-1-1.html

jonn

重复内容 见下帖

jonn

opiona 发表于 2018-6-10 20:34
其他请参考：关于自定义函数的使用理解及函数集锦

http://club.excelhome.net/thread-1279693-1-1.html

就是 这一段代码 无法用现有工作表的N值 和参数X1 工作表中的单元格数据对比，现在的公式只是现有工作单元格数据对比。如何能取到参数中的工作表名称或index 将可以解决。
感谢opiona的帮助！！

'日期范围内判断 取日期1前1天日期
For i = ii1 To ii1 + ii - 1
'无法解决 与其他表的数值对比
   If N >= Cells(i, X2.Column) And N < Cells(i, X3.Column) Then
     If Cells(i + 1, X3.Column) <> Cells(i, X2.Column) Then
       ALV = Cells(i, X2.Column) - 1
     Else
     ALV = Cells(i + 1, X2.Column) - 1
     End If
   Exit Function
   End If
Next i

jonn

回帖审核有点慢----------

其他模块我都用函数测试 发现错误在于日期数据比较部分  现有的表达方式 只是当前工作表的数据对比，
无法实现 当前工作表的B列的值 和另外工作表DATA的值进行对比；

如果能解决获取参数中的工作表名称，那应该就可以。
感谢opiona 出手帮忙！！！！！谢谢

'日期范围内判断 取日期1前1天日期
For i = ii1 To ii1 + ii - 1
'无法解决 与其他表的数值对比
   If N >= Cells(i, X2.Column) And N < Cells(i, X3.Column) Then
     If Cells(i + 1, X3.Column) <> Cells(i, X2.Column) Then
       ALV = Cells(i, X2.Column) - 1
     Else
     ALV = Cells(i + 1, X2.Column) - 1
     End If
   Exit Function
   End If
Next i