|
或者这样排列
- Sub tqwb()
- Dim a() As String, b() As String, i&, r%, Arr1(), ks, js
- Dim x&, Brr, aa, j&, m&, ii&
- Open ThisWorkbook.Path & "\数据.txt" For Input As #1
- a = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
- For i = 0 To UBound(a)
- If InStr(a(i), "6201") Then
- r = r + 1
- ReDim Preserve Arr1(1 To r)
- Arr1(r) = i
- End If
- Next
- ReDim Brr(1 To UBound(a), 1 To 4)
- For j = 1 To r
- If j <> r Then
- js = Arr1(j + 1) - 1
- Else
- js = UBound(a)
- End If
- ks = Arr1(j) + 1
- For i = ks To js
- ReDim b(1 To 4)
- m = m + 1
- For ii = 1 To Len(a(i)) Step 32
- b(Int(ii / 32) + 1) = Mid(a(i), ii, 32)
- Next
- For x = 1 To 4
- If b(x) <> "" Then
- Brr(m, x) = Split(Split(b(x), ".,")(1), ",")(0)
- End If
- Next
- Next
- m = m + 1
- Next
- Close #1
- Sheet1.Activate
- Cells.Clear
- [a1].Resize(UBound(Brr), 4) = Brr
- End Sub
复制代码 |
|