Shocker.ProAlexFrimBelovoДа нужна автоматизациятогда вопрос, вы хотите сами что-то писать и вам нужна помощь? или вы хотите, чтобы для вас сделали некий продукт - конвертор?
Хотел бы сам написать и нужна помощь. С переносом данных в Exel с подготовленного файла я думаю что разберусь, а вот как лишнее убрать это проблема не хватает знаний:(
Я похожее решение нашел для редактирования txt файла:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
Private Sub Command1_Click()
Dim papka As String: papka = "H:\"
Dim file1 As String: file1 = ""
Dim file2 As String: file2 = ""
file1 = Dir(papka & "*.txt")
Do While file1 <> ""
file2 = Mid(file1, 1, 8) & ".txt"
Delete_String papka & file1, papka & file2
file1 = Dir
Loop
End Sub
Private Sub Delete_String(ByVal file1 As String, ByVal file2 As String)
On Error GoTo err1
Dim myCol As New Collection
Dim Buf As String, slovo
Dim i As Long, copy_ As Byte
Dim kod As Integer
Dim stroka As String
Open file1 For Input As #1
Do While Not EOF(1)
Line Input #1, Buf
Buf = Replace(Buf, "'", "") 'удалить апостроф
slovo = Split(LTrim("" & Buf), " ") 'разбить строку по словам через пробел
If UBound(slovo) > 0 Then
kod = Asc(Mid(slovo(0), 1, 1))
If kod >= 48 And kod <= 57 Then 'если код, первого символа, цифра
stroka = ""
For i = 0 To UBound(slovo)
If slovo(i) <> "" Then 'собрать строку, без пробелов
stroka = stroka & slovo(i) & " "
End If
Next
myCol.Add stroka
End If
End If
Loop
Close #1
Open file2 For Append As #1
For i = 1 To myCol.Count
Print #1, myCol(i)
Next i
Close #1
Exit Sub
err1:
MsgBox Err.Description
Учимся использовать тэги оформления кода -
FAQ
Только с выборкой данных тяжело. В результате выполнения макроса получается новый текстовый фал но в нем много лишних данных остаётся.
