Пересортировка текстового файла

[fishmen]

Доброго всем дня,
Подскажите плиз, как пересортировать текстовый файл. Т.е есть исходный файл, где записи расположены в определенном порядке. Необходимо просмотреть все записи этого файла и некоторые записи, отвечающие определенным условиям передвинуть, т.е записать в определенное место этого файла. Например, строки файла до..
1, 2, 3, 4
1, 2, 3, 5
2, 3, 4, 5
3, 4, 5, 6,
1, 2, 4, 7

После
1, 2, 3, 4
1, 2, 3, 5
1 ,2, 4, 7
2, 3, 4, 5
3, 4, 5, 6,

[lister]

Нужно именно в VB?

Как вариант, можно в Excel...

[fishmen]

Нужно именно в VB?

Как вариант, можно в Excel...

Нужно или в VB или VBA. Файл привел для примера, реальный конечно сложнее. Мне бы хотя бы алгоритм

[Andrey Fedorov]

Э... Вот если бы входной файл был такой:

1;2;3;4
1;2;3;5
2;3;4;5
3;4;5;6
1;2;4;7

То отсортировать его - совсем не проблема:

Код: Выделить всё

Public Sub Main()
    Const sPathIn As String = "C:\Temp\"
    Const sPathOut As String = "C:\Temp\"
    Const sFileIn As String = "File.txt"
    Const sFileOut As String = "NewFile.txt"

    Dim cn As New ADODB.Connection, r As New ADODB.Recordset

    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & sPathIn & ";" & _
          "Extended Properties=""text;HDR=NO"""
   
    On Error Resume Next
    Kill sPathOut & sFileOut
    Kill sPathOut & "schema.ini"
   
    On Error GoTo Err_
    r.Open "SELECT * INTO [" & sFileOut _
                    & "] IN '" & sPathOut & "'[Text;HDR=No] " _
            & "FROM [" & sFileIn _
            & "] ORDER BY 1,2,3,4", cn, _
                    adOpenStatic, adLockReadOnly, adCmdText
    On Error Resume Next
    Kill sPathOut & "schema.ini"
    Exit Sub
   
Err_:
    With cn.Errors(0)
        If .NativeError = -329323426 And .Number = -2147467259 Then Resume Next
    End With
    MsgBox Err.Description, vbCritical
End Sub

Дальше - думай

[fishmen]

Да, к моему стыду даже не предпологал, что с текстовым файлом можно работать как с обычной базой данных.
Спасибо огромное. Пока не смог решить вопрос - как в ORDER BY указать номера колонок для сортировки? Имеют ли столбцы какие-нибудь условные обозначения, чтобы явно не указывать? В реальном файле данные могут быть любые.

[Andrey Fedorov]

Пока не смог решить вопрос - как в ORDER BY указать номера колонок для сортировки? Имеют ли столбцы какие-нибудь условные обозначения, чтобы явно не указывать? В реальном файле данные могут быть любые.

Хм... Наверно так же как и в моем примере - указывая их номер...

[Andrey Fedorov]

В общем, сделал решение и с запятыми в качестве разделителя:

Код: Выделить всё

Public Sub Main()
    Const sPathIn As String = "C:\Temp\"
    Const sPathOut As String = "C:\Temp\"
    Const sFileIn As String = "File.txt"
    Const sFileOut As String = "NewFile.txt"

    Dim cn As New ADODB.Connection, r As New ADODB.Recordset, _
        s As String, ss As String, sSchemaIni As String, i As Integer

    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & sPathIn & ";" & _
          "Extended Properties=Text"

    ' Создадим файл откуда берем данные для теста
    For i = 0 To 100
        s = Mid$(Format$(Rnd, ".0000000"), 2)
        ss = ss & Mid$(s, 1, 1) & "," & Mid$(s, 2, 1) & "," & Mid$(s, 3, 1) & "." & CInt(Mid$(s, 4, 3)) & "," & Mid$(s, 7, 1) & vbCrLf
    Next i
    s = sPathOut & sFileIn
    If FileExists(s) Then Kill s
    SaveFile s, ss
   
    ' Удалим выходной файл
    s = sPathOut & sFileOut
    If FileExists(s) Then Kill s
   
    ' Создадим schema.ini
    sSchemaIni = sPathOut & "schema.ini"
    If FileExists(sSchemaIni) Then Kill sSchemaIni
    ss = "[File.txt]" & vbCrLf _
        & "ColNameHeader=False" & vbCrLf _
        & "CharacterSet=1251" & vbCrLf _
        & "Format=Delimited(,)" & vbCrLf _
        & "DecimalSymbol=." & vbCrLf _
        & "Col1=F1 Integer" & vbCrLf _
        & "Col2=F2 Integer" & vbCrLf _
        & "Col3=F3 Float" & vbCrLf _
        & "Col4=F4 Integer" & vbCrLf _
        & vbCrLf _
        & "[NewFile.txt]" & vbCrLf _
        & "ColNameHeader=False" & vbCrLf _
        & "CharacterSet=1251" & vbCrLf _
        & "Format=Delimited(,)" & vbCrLf _
        & "DecimalSymbol=." & vbCrLf _
        & "NumberDigits=4" & vbCrLf _
        & "Col1=F1 Integer" & vbCrLf _
        & "Col2=F2 Integer" & vbCrLf _
        & "Col3=F3 Float" & vbCrLf _
        & "Col4=F4 Integer" & vbCrLf
       
    SaveFile sSchemaIni, ss
   
    ' Импортируем данные
    On Error GoTo Err_
    r.Open "SELECT * INTO [" & sFileOut _
                    & "] IN '" & sPathOut & "' [Text;] " _
            & "FROM [" & sFileIn _
            & "] ORDER BY 1,2,3,4", cn, _
                    adOpenStatic, adLockReadOnly, adCmdText
    If FileExists(sSchemaIni) Then Kill sSchemaIni
    Exit Sub

Err_:
    With cn.Errors(0)
        If .NativeError = -329323426 And .Number = -2147467259 Then Resume Next
    End With
    MsgBox Err.Description, vbCritical
End Sub

Private Function FileExists(sFile As String) As Boolean
    On Error Resume Next
    FileExists = ((GetAttr(sFile) And vbDirectory) = 0)
    If Err.Number Then Err.Clear
End Function

Private Sub SaveFile(sFile As String, sText As String)
    Dim iHFile As Integer
   
    iHFile = FreeFile
    Open sFile For Binary As #iHFile
    Put iHFile, , sText
    Close #iHFile
End Sub


Ну и полезная ссылка на данную тему.

[fishmen]

Спасибо!!! Это то что нужно.
Буду разбираться.