当前位置：首页 → 问答吧 → 提取文本中所需的值。

提取文本中所需的值。

时间：2011-08-09

来源：互联网

请看附件，需要在文本中提取相同值对应到EXCEL中的SHEET1和SHEET2中（RACOTAKEDTAPI和RMDOWNMSG2I），请各位帮忙看看如何操作。谢谢！

[ 本帖最后由 qing33670000 于 2011-8-9 11:41 编辑 ]

附件

文本提取值到EXCEL.rar(3.62 KB)

2011-8-9 11:27, 下载次数: 16

作者: qing33670000 发布时间: 2011-08-09

LSN=H'012的记录?

作者: liuguansky 发布时间: 2011-08-09

不是，是RACOTAKEDTAPI和RMDOWNMSG2I

作者: qing33670000 发布时间: 2011-08-09

复制内容到剪贴板

代码:

Sub drwb()
Dim a() As String, bb, i&, n&, r&, Arr1(), j&
On Error Resume Next
Open ThisWorkbook.Path & "\文本.txt" For Input As #1
a = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
aa = Array("RACOTAKEDTAPI", "RMDOWNMSG2I")
For j = 0 To 1
      r = 0
      For i = 0 To UBound(a)
         If InStr(a(i), aa(j)) Then
            r = r + 1
            ReDim Preserve Arr1(1 To 4, 1 To r)
            Arr1(2, r) = aa(j)
            bb = Split(a(i + 2), ")")(1)
            n = InStr(bb, "=")
            Arr1(3, r) = Left(bb, n)
            Arr1(4, r) = Mid(bb, n + 1)
            Arr1(1, r) = a(i + 3)
         End If
      Next
      If j = 0 Then
         Sheet1.Activate
         Cells.ClearContents
         [a1].Resize(r, 4) = Application.Transpose(Arr1)
      Else
         Sheet2.Activate
         Cells.ClearContents
         [a1].Resize(UBound(Arr1, 2), 4) = Application.Transpose(Arr1)
      End If
      Erase Arr1
Next
Close #1
End Sub

作者: 蓝桥玄霜发布时间: 2011-08-09

请见附件。