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
7 нояб. 2013 г.
Перестановка колонок, выделение Ф.И.О из ФИО
Фокус еще в том, что исходный файл был DBF-ом, поэтому данные с 3 строки попадают в 1-ю в назначение (чтобы не трогать заголовки колонок)