Мне приятно быть полезным. Будьте свободны с любыми проблемами в адаптации кода.

ема продолжаетсяэто тема и связана смой предыдущий пост, Код должен работать с файлами .csv, меняющими значения ячеек и цвет интерьера. Это делает свою работу, но после сохранения .txt как .csv я получаю что-то похожее на исходный файл - никаких изменений не видно.

Я думал об использовании словарей, но, насколько я понимаю, для этого мне пришлось отредактировать недавно сохраненный файл .csv, чего я и стараюсь избегать в приведенном ниже коде. У кого-нибудь есть идеи как сохранить изменения?

Option Explicit

Sub fixCellsValue()
Dim wrk As Workbook
Dim Sh As Worksheet
Dim SourceFolder As String, Path As String, TmpFlName As String
Dim i As Long, lastrow As Long

SourceFolder = ThisWorkbook.Path & "\source"

'creating temporary .txt file
If Dir(SourceFolder & "SomeFile.*") <> "" Then
    If InStr(1, Dir(SourceFolder & "SomeFile.*"), ".csv") Then
                    TmpFlName = SourceFolder & "\TmpCsv.txt"
                    If Dir(TmpFlName) <> "" Then Kill TmpFlName
                    FileCopy SourceFolder & "SomeFile.csv", TmpFlName
                    Workbooks.OpenText Filename:=TmpFlName, origin:= _
                    1250, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                    ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
                    , Space:=False, Other:=False, TrailingMinusNumbers:=True, Local:=False

                    Set wrk = Application.Workbooks("TmpCsv.txt")
                    Set Sh = wrk.Worksheets(1)

        lastrow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).row

        'implementing changes to the temporary .txt file
        For i = 2 To lastrow
            If Len(Sh.Cells(i, 5)) > 10 Then
                Sh.Cells(i, 5) = Left$(Sh.Cells(i, 5).Value, 10)
                Sh.Cells(i, 5).Interior.ColorIndex = 6
            End If
        Next i

    End If
End If

'saving as .csv file and deleting .txt file
If InStr(1, wrk.Name, "TmpCsv.txt") Then
    wrk.SaveAs Filename:=Dir(SourceFolder & "SomeFile.*"), FileFormat:=xlCSV, Local:=True
    wrk.Close Savechanges:=True
    Kill TmpFlName
End If
End Sub

Ответы на вопрос(1)

Ваш ответ на вопрос