Board logo

标题: [文本处理] 【已解决】怎样历遍一列数值,找出相同数组中最少的一个,并取该数组的前一个数? [打印本页]

作者: 思想之翼    时间: 2013-4-1 19:10     标题: 【已解决】怎样历遍一列数值,找出相同数组中最少的一个,并取该数组的前一个数?

本帖最后由 思想之翼 于 2013-4-4 12:21 编辑

下列txt文本中,以纵列方式记录一列数值。
5
2
3
2
5
2
3
10
3
18
5
2
3
2
......

第1行数值是5,该列中还有2个为5的数值(第5行、第11行);
第1、2行的连续数值是52,该列中还有2个连续数值是52(第5、6行,第11、12行);
第1、2、3行连续数值是523,该列中还有2个连续数值是523(第5、6、7行,第11、12、13行);
第1、2、3、4行连续数值是5232,该列中有1个连续数值是5232(第11、12、13、14行);
第1、2、3、4、5行连续数值是52325,该列中没有连续数值是52325。
故最少相同的数组是5232。
(注:先查找没有的数组,再查找最少的数组,速度要快些。)

现在找出了最少相同的数组5232,该相同数组5232前一个数值为18(第10行),取出该数值,写入新建的txt文本。

若找出的最少相同数组不止一个,则分别取出该相同数组前一个数值,依次写入新建的txt文本。

欲实现上述思路,还望得到大家的帮助!
作者: CrLf    时间: 2013-4-2 19:46

看了两遍,还是晕乎乎...
你的输出格式到底是啥呢?
作者: apang    时间: 2013-4-2 20:17

只比较包含第一行的数据还是?比如第2、3、4行(232)和第12、13、14行(232)相同,可以不用比较是吧?
极端情况,假设该列数据全部相同,比如全部是5,肿么处理?
作者: 思想之翼    时间: 2013-4-2 22:35

本帖最后由 思想之翼 于 2013-4-2 22:55 编辑

回复 3# apang

谢谢关注和帮助!

只比较包含第1行、且行数连续的数据,比如第1行;第1、2行;第1、2、3行;第1、2、3、4行;第1、2、3、4、5行......

也即:

如果第1、2、3、4、5、6、7、8行,这8个数据分别是5 2 3 2 5 2 3 10,则寻找该列数据中,是否还有同样顺序的数据存在;

如果没有,则减少一行,寻找第1、2、3、4、5、6、7行,即5 2 3 2 5 2 3这7个数据,在该列中是否还有同样顺序的数据存在;

如果没有,就再减少一行,寻找第1、2、3、4、5、6行,即5 2 3 2 5 2这6个数据,在该列中是否还有同样顺序的数据存在,如果有,则提取这组数据的前一个数据。

该列数据全部相同的极端情况,在统计的数据中不会存在,是我没有说明白。

输出格式:
如果提取的数据是2,在新建的txt文本中作如下表示
2
如果提取的数据是2,10,在新建的txt文本中作如下表示
2
10
作者: 思想之翼    时间: 2013-4-2 22:45

回复 2# CrLf

谢谢您的关注和帮助!
输出格式:
如果提取的数据是2,在新建的txt文本中作如下表示
2
如果提取的数据是2,10,在新建的txt文本中作如下表示
2
10
作者: apang    时间: 2013-4-3 20:22

  1. Set fso = CreateObject("Scripting.FileSystemObject")
  2. set file = fso.OpenTextFile("a.txt")
  3. Do Until file.AtEndOfStream
  4.    strLine = file.ReadLine
  5.    If strLine <> "" Then
  6.       ReDim PreServe ar(n)
  7.       strIn = strIn & "$" & strLine & " "
  8.       ar(n) = strIn : n = n + 1
  9.    End If
  10. Loop
  11. For i = CLng(UBound(ar)/2) to 0 step -1
  12.    ar1 = Split(strIn,ar(i))
  13.    If UBound(ar1) > 1 Then
  14.       For j = 1 to UBound(ar1) - 1
  15.          WriteToFile Split(ar1(j)),Split(ar(i))
  16.       Next
  17.       Exit For
  18.    End If
  19. Next
  20. MsgBox "OK"
  21. Sub WriteToFile(ar2,ar3)
  22.    If UBound(ar2) >= 1 Then
  23.       strOut = Mid(ar2(UBound(ar2)-1),2)
  24.    Else
  25.       strOut = Mid(ar3(UBound(ar3)-1),2)
  26.    End If
  27.    fso.OpenTextFile("b.txt",8,True).WriteLine strOut
  28. End Sub
复制代码
保存为test.vbs,试试看,a.txt中不要包含空白字符的行。
作者: 思想之翼    时间: 2013-4-4 10:10

本帖最后由 思想之翼 于 2023-3-2 11:51 编辑

回复 6# apang

谢谢您的帮助!代码运行快速,结果正确。
上述是仅有1列数据的运算,实际运用中txt文本有126列数据。
126列的txt文本格式:
5    15   ...
2    12   ...
6    6     ...
3    13   ...
9    9     ...
8    18   ...
10  10   ...
11  11   ...
12  2     ...
15  15   ...
18  18   ...
9    9    ...
16  6    ...
提取数据写入b.txt文本的格式:
2     13 ...
10   8   ...
9     6   ...


解决方案:
Set fso = CreateObject("Scripting.FileSystemObject")
For f = 1 to 300
Set file = fso.OpenTextFile(f & ".txt")  
m = 21 : Max = 0    'm=总列数,Max=输出最大行数
ReDim arIn(m-1) : ReDim arOut(m-1)
Do Until file.AtEndOfStream
   strLine = RegEx(file.ReadLine)
   If strLine <> "" Then
      ReDim PreServe ar(m-1,n)
      For i = 0 to m-1
         arIn(i) = arIn(i) & "$" & Split(strLine)(i) & " "
         ar(i,n) = arIn(i)
      Next
      n = n + 1
   End If
Loop

For i = 0 to m-1
   For j = CLng(n/2) to 0 step -1
      ar1 = Split(ar(i,n-1),ar(i,j))
      If UBound(ar1) > 1 Then
         For k = 1 to UBound(ar1) - 1
            a = UBound(Split(ar1(k))) - 1
            b = UBound(Split(ar(i,j))) - 1
            If a >= 0 Then
               arOut(i) = arOut(i)&Mid(Split(ar1(k))(a),2)&" "
            Else
               arOut(i) = arOut(i)&Mid(Split(ar(i,j))(b),2)&" "
            End If
         Next
         Exit For
      End If
   Next
   If UBound(Split(arOut(i))) > Max Then Max = UBound(Split(arOut(i)))
Next

For i = 0 to Max - 1
   For j = 0 to m-1
      If UBound(Split(arOut(j))) >= i Then
         strOut = strOut & Split(arOut(j))(i) & vbTab
      Else strOut = strOut & vbTab
      End If
   Next
   strOut = Left(strOut,Len(strOut)-1) & vbCrLf
Next

fso.OpenTextFile("z" & f & ".txt",2,True).Write strOut

strOut = "" : n = "0"
Next
CreateObject("Wscript.Shell")

Function RegEx(strLine)
   Set re = New RegExp
   re.Pattern = "\s+"
   re.Global = True
   RegEx = Trim(re.Replace(strLine," "))
End Function
作者: cs_t    时间: 2013-4-5 14:02

apang是个好同志,支持一下
作者: 思想之翼    时间: 2023-3-1 15:17

本帖最后由 思想之翼 于 2023-3-3 10:24 编辑

回复 6# apang
感谢您的帮助!




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2