[已解决]excel 函数转 VBA

lkk0063

是否可以将以下函数转成VBA，并于A栏位与B栏位输入后，自动比对，若比对不同秀出警示讯息, 并自动反红
=MID(A2,FIND("-",A2)+1,2)-DAY(B2)=0

主要需求：
将 16122309-0208 其中 02(即-0208 第二位与第三位) 与 1/2 中的 2(即1月2日的2)比对 ，一样不动作，不同则秀出警示讯息

最佳答案

月排行榜 / 总排行榜

grf1973

2017-9-25 15:54

1. Sub 比对()
   
2.     arr = Range("a2:b" & [a65536].End(3).Row)
   
3.     ReDim brr(1 To UBound(arr), 1 To 1)
   
4.     For i = 1 To UBound(arr)
   
5.         x = Mid(Split(arr(i, 1), "-")(1), 1, 2)
   
6.         brr(i, 1) = IIf(Val(x) = Day(arr(i, 2)), "OK", "NG")
   
7.     Next
   
8.     [C2].Resize(UBound(arr)) = brr
   
9. End Sub
   

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 比对()
   
2.     arr = Range("a2:b" & [a65536].End(3).Row)
   
3.     ReDim brr(1 To UBound(arr), 1 To 1)
   
4.     For i = 1 To UBound(arr)
   
5.         x = Mid(Split(arr(i, 1), "-")(1), 1, 2)
   
6.         brr(i, 1) = IIf(Val(x) = Day(arr(i, 2)), "OK", "NG")
   
7.     Next
   
8.     [C2].Resize(UBound(arr)) = brr
   
9. End Sub
   

复制代码

lkk0063

grf1973 发表于 2017-9-25 15:54

你好，
谢谢快速回覆，仍有一个问题请教
若我比对范围为A栏位与C栏位比对，我有尝试修改比对范围，但出现错误(出现1004错误)，请问如何修改，谢谢
arr = Range("a2" & "d2" & [a65536].End(3).Row)

lkk0063

lkk0063 发表于 2017-9-25 16:56
你好，
谢谢快速回覆，仍有一个问题请教
若我比对范围为A栏位与C栏位比对，我有尝试修改比对范围，但出 ...

测试好久, 终于修改好了,分享给大家

1. Private Sub CommandButton1_Click()
   
2.     arr = Range("a2:c" & [a65536].End(3).Row)
   
3.     ReDim brr(1 To UBound(arr), 1 To 3)
   
4.     For i = 1 To UBound(arr)
   
5.         x = Mid(Split(arr(i, 1), "-")(1), 1, 2)
   
6.         brr(i, 1) = IIf(Val(x) = Day(arr(i, 3)), "OK", "NG")
   
7.     Next
   
8.     [d2].Resize(UBound(arr)) = brr
   
9. End Sub

复制代码