楼主
芐雨 |
要求：
文本<数据库>，是由几百组四个数字组成的字符串，数字间隔为空格，数字格式为00。如：01 02 03 04
EXCEL中有多个筛选字符串的条件，如：M|03 04 09 12 13，对应个数：1,2
最小允错值：0，最大允错值：2
从文本中提取第一个字符串，如：01 02 03 04，判断01，02，03，04在筛选条件里（M|03 04 09 12 13）的对应个数，对应个数为2，
文本第一个字符串：
excel第一个筛选条件：
允错值为0
01 02 03 04，判断01，02，03，04在筛选条件里（M|03 04 09 12 13）的对应个数，对应个数为2，2在【1，2】，则允错值仍为0
继续用01 02 03 04判断
excel第二个筛选条件：
对应个数为0，不在对应个数【1，2】里，允错值加1，0+1变为1
继续向第三个筛选条件判断
继续向第四个筛选条件判断
……
第一个字符串判断完所有筛选条件，则提取下一个字符串，允错值归0，重新判断筛选条件
结果：每组判断完所有筛选条件，若：最小允错值<=允错值<=最大允错值,则把这一字符串导出到新的文本【筛选结果】
代码如下：
- Sub 筛选条件导出TXT_芐雨()
- Dim ar, A$, B$, C$, D$, t$, E%, Fx%
- t = Timer
- Open ThisWorkbook.Path & "\" & "数据库.txt" For Binary As #1 '打开文本
- ar = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
- Close #1
- Fmin = [d6] '最小允错值
- Fmax = [e6] '最大允错值
- br = [i9].CurrentRegion '筛选条件范围
- Open ThisWorkbook.Path & "\" & "筛选结果.txt" For Output As #1 '打开文本，无则创建，有则覆盖。
- For i = 0 To 999 '遍历数组，空格拆分
- Fx = 0
- A = Split(ar(i), " ")(0)
- B = Split(ar(i), " ")(1)
- C = Split(ar(i), " ")(2)
- D = Split(ar(i), " ")(3)
- For j = 1 To UBound(br) '遍历所有筛选条件
- E = 0
- If InStr(br(j, 1), A) = 1 Then E = E + 1 '查找值，记e为对应个数
- If InStr(br(j, 1), B) = 1 Then E = E + 1
- If InStr(br(j, 1), C) = 1 Then E = E + 1
- If InStr(br(j, 1), D) = 1 Then E = E + 1
- If InStr(br(j, 3), E) = 0 Then Fx = Fx + 1 '对应个数e不在E列条件中，允错值Fx加1
- If Fx > Fmax Then Exit For '允错值大于最大允错值时跳出
- Next
- If j > UBound(br) Then
- If Fx >= Fmin Then Print #1, ar(i) '最后一个条件时允错值，Fx<=Fmax时导出
- End If
- Next
- Close #1
- MsgBox Format(Timer - t, "0.000秒")
- End Sub
附件：
 按筛选条件导出TXT_芐雨.zip
|
