指定行的字符包含另两个指定区域的字符，求代码

lagos · 发表于 2024-3-9 14:05

详情请看附件：

求代码.rar (6.3 KB, 下载次数: 3) ，Q2:U2的字符最少包含了F2：L2的任一字符，且同时最少包含AY2:BA2的任一字符，就在O2写1，否则写入0

^星^ · 发表于 2024-3-9 14:22

求代码.zip (14.44 KB, 下载次数: 11)

lagos · 发表于 2024-3-9 14:53

本帖最后由 lagos 于 2024-3-9 14:59 编辑

^星^ 发表于 2024-3-9 14:22

大神，对Function过程一无所知，只对SUB知道一点点，不知道如何用SUB调用这个Function过程。更改了字符后竟不知道如何运行，如果能用sub过程写一个更好了，万分感谢。，使用2007版的

^星^ · 发表于 2024-3-9 15:01

lagos 发表于 2024-3-9 14:53
大神，对Function过程一无所知，只对SUB知道一点点，不知道如何用SUB调用这个Function过程。更改了字符后 ...

和调用普通函数一样的

gwjkkkkk · 发表于 2024-3-9 18:02

你这个表格设置取数比较难，故用自定义函数比较方便，通过函数返回，在表格中区域数组形式返回。

gwjkkkkk · 发表于 2024-3-9 18:37

Option Explicit
Sub TEST2()
Dim ar, br, cr, dr, i&, j&, m&, n&, isFlag1 As Boolean, isFlag2 As Boolean

Application.ScreenUpdating = False

ar = [F2:L8].Value
br = [Q2:U8].Value
cr = [AY2:BA8].Value

ReDim dr(1 To UBound(ar), 0)
For i = 1 To UBound(ar)
      isFlag1 = False: isFlag2 = False
      For j = 1 To UBound(ar, 2)
         If Len(ar(i, j)) Then
            For m = 1 To UBound(br, 2)
                  If ar(i, j) = br(i, m) Then isFlag1 = True: Exit For
            Next m
         End If
      Next j
      For j = 1 To UBound(ar, 2)
         If Len(ar(i, j)) Then
            For n = 1 To UBound(cr, 2)
                  If ar(i, j) = cr(i, n) Then isFlag2 = True: Exit For
            Next n
         End If
      Next j
      If isFlag1 * isFlag2 Then dr(i, 0) = 1 Else dr(i, 0) = 0
Next i

[Y2].Resize(UBound(dr)) = dr

Application.ScreenUpdating = True
Beep
End Sub

gwjkkkkk · 发表于 2024-3-9 18:38

请参考。。。

		自动登录	找回密码
密码			免费注册

[求助] 指定行的字符包含另两个指定区域的字符，求代码

评分

评分