7 нояб. 2013 г.

Перестановка колонок, выделение Ф.И.О из ФИО

Фокус еще в том, что исходный файл был DBF-ом, поэтому данные с 3 строки попадают в 1-ю в назначение (чтобы не трогать заголовки колонок)
Sub ConvertDBF()
    Sheets("DST").Columns("A:A").ColumnWidth = 3
    Sheets("DST").Columns("B:B").ColumnWidth = 5
    Sheets("DST").Columns("B:B").NumberFormat = "@"
    Sheets("DST").Columns("C:C").ColumnWidth = 5
    Sheets("DST").Columns("D:D").ColumnWidth = 6
    Sheets("DST").Columns("E:E").ColumnWidth = 8
    Sheets("DST").Columns("F:F").ColumnWidth = 23
    Sheets("DST").Columns("G:G").ColumnWidth = 23
    Sheets("DST").Columns("H:H").ColumnWidth = 23
    Sheets("DST").Columns("I:I").ColumnWidth = 21
    Sheets("DST").Columns("J:J").ColumnWidth = 12
    i = 3
    Do
        If Sheets("SRC").Cells(i, 5).Value = "" Then
            Exit Do
        End If
        Sheets("DST").Cells(i - 2, 1) = Sheets("SRC").Cells(i, 4)
        Sheets("DST").Cells(i - 2, 2) = "002"
        Sheets("DST").Cells(i - 2, 3) = "21"
        Sheets("DST").Cells(i - 2, 4) = Sheets("SRC").Cells(i, 6)
        Sheets("DST").Cells(i - 2, 5) = Sheets("SRC").Cells(i, 7)
        FIO = Trim(Sheets("SRC").Cells(i, 5))
        FirstSpacePos = InStr(1, FIO, " ", vbTextCompare)
        If FirstSpacePos > 0 Then
              Sheets("DST").Cells(i - 2, 6) = Left(FIO, FirstSpacePos - 1)
        End If
        SecondSpacePos = InStr(FirstSpacePos + 1, FIO, " ", vbTextCompare)
        If SecondSpacePos > 0 Then
              Sheets("DST").Cells(i - 2, 7) = Mid(FIO, FirstSpacePos + 1, SecondSpacePos - FirstSpacePos)
              Sheets("DST").Cells(i - 2, 8) = Mid(FIO, SecondSpacePos + 1)
        End If
        Sheets("DST").Cells(i - 2, 9) = Sheets("SRC").Cells(i, 14)
        Sheets("DST").Cells(i - 2, 10) = Sheets("SRC").Cells(i, 12)
    

        i = i + 1
    Loop
End Sub