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
Показаны сообщения с ярлыком Excel. Показать все сообщения
Показаны сообщения с ярлыком Excel. Показать все сообщения
7 нояб. 2013 г.
Перестановка колонок, выделение Ф.И.О из ФИО
Фокус еще в том, что исходный файл был DBF-ом, поэтому данные с 3 строки попадают в 1-ю в назначение (чтобы не трогать заголовки колонок)
1 авг. 2013 г.
Округление в выделенном диапазоне, Excel
Sub MyRoundRange()
For Each cell In Selection
cell.Value = WorksheetFunction.Round(cell.Value, 0)
Next cell
End Sub
19 июн. 2013 г.
Вывод из Excel в файл
Любят бухгалтера все делать в Excel.А Диасофт 4х4 грузит из текстовых файлов.
Const BASE = 9000
Sub Макрос1()
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\clients.txt", 2, 8)
i = 1
Do
If Cells(i, 1).Value = "" Then
Exit Do
End If
f.WriteLine ("%КЛИЕНТ")
f.WriteLine ("ИМЯ1 :" + Mid(Cells(i, 1).Value, 1, 40))
f.WriteLine ("ИМЯ2 :" + Mid(Cells(i, 1).Value, 41, 40))
f.WriteLine ("ИМЯ3 :" + Mid(Cells(i, 1).Value, 81, 40))
f.WriteLine ("ИМЯ4 :" + Mid(Cells(i, 1).Value, 121, 40))
f.WriteLine ("ТИП :Ю")
f.WriteLine ("АДРЕС1 :")
f.WriteLine ("АДРЕС2 :")
f.WriteLine ("ТЕЛЕФОН1 :")
f.WriteLine ("ТЕЛЕФОН2 :")
f.WriteLine ("КОД :" + Trim(Str(i + BASE)))
f.WriteLine ("ИНН :" + Trim(Str(Cells(i, 2).Value)))
f.WriteLine ("КПП :" + Trim(Str(Cells(i, 3).Value)))
f.WriteLine ("ГРУППА :Юридические лица")
f.WriteLine ("ДЕЙСТВИЕ :Add")
f.WriteLine ("%END")
i = i + 1
Loop
f.Close
End
End Sub
Подписаться на:
Сообщения (Atom)