Правка макроса по обработке txt файла

[alexsampler]

Добрый день, знатоки Excel-я!
Вчера сделал запрос о помощи в макросе, но ответ так и не получил, наверное слишком много вопросов - решил упростить задачу ...

Excel 2003. Макрос создан макрорекордером и обрабатывает txt файл с балансом. Все вроде бы настроил, но остается проблема съехавших влево подитогов по строкам - это в самом тексте (их нужно вернуть на место) и необходимо добавить столбец с последующей простановкой двух определенных символов по условию.

Макрорекордером пользоваться умею, а дальше пока знаний не хватает.
Помогите, пожалуйста!!!! Все в примере

[doober]

Вчера сделал запрос о помощи в макросе, но ответ так и не получил

Во вложении не хватает текстового файла для импорта.

[alexsampler]

Понял, исправляюсь.
Архив тот же плюс в нем исхоный файл txt.

[Hugo121]

Думаю, там нужен вообще другой подход.
Но муторно, рутина... Поэтому все молчат

И вообще - я бы из этого текстового файла делал два листа - в одном актив, в другом пассив.
Шапки рисуем кодом, как у Вас уже сделано, а далее читаем построчно файл, смотрим чтоб с позиции например 25 были два символа-числа и с помощью Cdbl(Trim(mid())) наполняем таблицу.
Одновременно для одной таблицы ищем "Итого по активу", для второй "Итого по пассиву" - значит пора подводить черту и со следующей строки будут итоги (хотя это видно и по тому, что в 25/2 числа, а в начале строки пусто).
Если итоги не нужны - тогда вообще просто - смотрим позицию Mid(2,5) - если число, то строку обрабатываем в первую таблицу.
Ну а если Mid(2,12)="П А С С И В", то далее пора второй лист начинать.

[doober]

Ловите

Sub Get_TXT()
        Dim Filename As String
        Filename = Get_Filename
        If Filename = "False" Then Exit Sub
        Dim flag1 As Boolean, flag2 As Boolean, Row As Integer
        Row = 3
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objTextFile = objFSO.OpenTextFile(Filename, 1)
        Application.ScreenUpdating = False
        With ActiveSheet
                Do Until objTextFile.AtEndOfStream
                        strNextLine = objTextFile.ReadLine
                        If InStr(1, strNextLine, "----", vbTextCompare) = 0 Then
                                If flag1 = True And Len(Trim(strNextLine)) > 2 Then
                                        sd = Mid(strNextLine, 1, 7)
                                        If Val(Trim(sd)) > 0 Then
                                                If flag2 Then
                                                        .Cells(Row, 2) = "П"
                                                Else
                                                        .Cells(Row, 2) = "А"
                                                End If
                                        End If
                                        .Cells(Row, 1) = sd
                                        For n = 1 To 12
                                                sd = Mid(strNextLine, 9 + 20 * (n - 1), 19)
                                                .Cells(Row, n + 2) = sd
                                        Next
                                        Row = Row + 1
                                End If
                        End If
                        If InStr(1, strNextLine, "А К Т И В", vbTextCompare) > 0 Then
                                flag1 = True
                        End If
                        If InStr(1, strNextLine, "П А С С И В", vbTextCompare) > 0 Then
                                flag2 = True
                        End If
                Loop
        End With
        Application.ScreenUpdating = True
        Set objTextFile = Nothing
        Set objFSO = Nothing
End Sub
Public Function Get_Filename(Optional Filter As String = "Файлы ,*.", Optional Title As String = "Выбираем файл")
        Dim vntFilename As Variant
        vntFilename = Application.GetOpenFilename(Filter, 1, Title, , False)
        Get_Filename = vntFilename
End Function

[alexsampler]

ОК! Если так все сложно, пожалуйста напишите пример как хотябы строку с итогами передвинуть на одну ячейку вправо используя ключевое слово. Может быть я пойму и тогда сам разбирусь. Я вполне обучаемый, просто долго "втыкаю".
Не может быть что бы такую процедуру нужно было описывать огромным кодом.
Что-то я опечален.....

[alexsampler]

Ай да doober, ай да ...... молодец!
Спасибо, буду разбираться.
Не сочтите за наглость и тупость если что-то уточнить придется

[Hugo121]

Шапку doober только забыл присобачить (сорри за каламбур )
И суперски обошёл рутину - что-то я не подумал, что там можно цикл использовать...

Ну для шапки у Вас код есть.

[doober]

Сообщение от alexsampler

Не сочтите за наглость и тупость если что-то уточнить придется

Буду только после 22 по Москве,тогда и отвечу

[Hugo121]

Сергей, может для надёжности объявить
Dim sd As Double
Или где-то уйдёт в ошибку (не проверял)?