Автор: agrippa
Дата сообщения: 22.08.2006 20:00
Yuk
Здравствуй. С прошлым заданием я разобрался. Но сейчас мне снова нужна помощь. Помоги,пожалуйста. Это очень важно.
Вот этот макрос преобразовывает *.txt файлы в нужный мне вид в Exel.
Пример таких текстовых файлов я тебе присылал, но если ты их удалил, то могу отослать заного. Напиши в тему и я их пришлю.
Тут вот в чём дело: мой макрос вызывает OpenFileDialog сам, а мне надо сделать, чтобы он делал преобразования в уже открытом текстовом файле.
Также он создает на втором, третьем листе, и так далее две зоны, которые разделены двумя пробелами, а мне нужно, чтобы эти зоны были не друг под другом, а рядом, и были разделены двумя строками, и так на каждом листе, кроме первого, т.к. там должен быть этот файл в первозданном виде.
Sub Preobrazovanie()
Dim fs, a, Str
Dim Sh As Worksheet
Dim d() As String
Dim name As String
'открываем стандартый OpenFileDialog
fileToOpen = Application.GetOpenFilename("Text Files (*.*), *.*")
If fileToOpen <> False Then
name = fileToOpen
End If
'открываем файл для считывания по строкам
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.OpenTextFile(name)
'Set Sh = Worksheets("весь массив")
'Dim Dr As Range
'j = 1
List = 0
stroka = 0
stroka1 = 0
i = 1
'далеее в цикле до конца файла считываем все строки и анализируем их
List = List + 1
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
Do While a.AtEndOfStream <> True
stroka = stroka + 1 '.. и начинаем запись на новом листе с первой строки
Str = a.ReadLine 'присваеваем строковой переменной str строку из файла
Str = Trim(Str) 'удаляем пробелы в строке в начале и в конце
d = Split(Str, " ") 'в динамический массив d записываем значения из строки разделенные пробелом
If Str = "" Then 'если строка пустая т.е. нет ничего просто ее мереписываем на текущий лист
Worksheets(List).Cells(stroka, 1) = "" 'просто записываем в первую ячейку нового листа считанную строку с датой
Else
If IsNumeric(d(0)) Then 'если у нас в строке числа то
'...в цикле записываем последовательно в ячейки текущей строки переменные массива
'попутно их проверяя на число, т.к. могут встречаться и не цифры
For j = LBound(d) To UBound(d) 'цикл для последовательного считывания элементов динамического массива
If IsNumeric(d(j)) Then 'проверка на число
Worksheets(List).Cells(stroka, i) = CDbl(d(j)) 'запись в ячейку листа значения, которое было переведено из строкового типа в double
i = i + 1
End If
Next
i = 1
Else
Worksheets(List).Cells(stroka, 1) = Str 'просто записываем в первую ячейку нового листа считанную строку с датой
End If
End If
Loop
a.Close
Set a = fs.OpenTextFile(name)
Do While a.AtEndOfStream <> True
Str = a.ReadLine 'присваеваем строковой переменной str строку из файла
Str = Trim(Str) 'удаляем пробелы в строке в начале и в конце
d = Split(Str) 'в динамический массив d записываем значения из строки разделенные пробелом
stroka = stroka + 1
stroka1 = stroka1 + 1
'далее идут проверки
If Str = "" Then 'если строка пустая т.е. нет ничего просто ее мереписываем на текущий лист
Worksheets(List).Cells(stroka, 1) = Str
Worksheets(List).Cells(stroka + 31, 14) = Str
Else 'если строка не пустая то начинаются проверки ...
If IsDate(d(0)) Then 'если это дата то созаем новый лист
If Len(d(0)) > 5 Then
'создаем новый лист
List = List + 1
stroka = 1 '.. и начинаем запись на новом листе с первой строки
stroka1 = 1 '.. и начинаем запись на новом листе с первой строки
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(List).Cells(stroka, 1) = Str 'просто записываем в первую ячейку нового листа считанную строку с датой
Worksheets(List).Cells(stroka + 31, 14) = Str 'просто записываем в первую ячейку нового листа считанную строку с датой
End If
End If
If IsNumeric(d(0)) Then 'если у нас в строке числа то
'...в цикле записываем последовательно в ячейки текущей строки переменные массива
'попутно их проверяя на число, т.к. могут встречаться и не цифры
For j = LBound(d) To UBound(d) 'цикл для последовательного считывания элементов динамического массива
If IsNumeric(d(j)) Then 'проверка на число
Worksheets(List).Cells(stroka, i) = CDbl(d(j)) 'запись в ячейку листа значения, которое было переведено из строкового типа в double
Worksheets(List).Cells(stroka1 + 31, i + 13) = CDbl(d(j)) 'запись в ячейку листа значения, которое было переведено из строкового типа в double
i = i + 1
End If
Next
If i = 2 Then ' это условие необходимо для того чтобы писать две чиловые стороки файла в одну строку листа
stroka1 = stroka1 - 1
Else
i = 1
End If
Else
'если строка содержит просто какойто текст то, записываем его просто на лист
Worksheets(List).Cells(stroka, 1) = Str
Worksheets(List).Cells(stroka + 31, 14) = Str
End If
End If
Loop
a.Close
End Sub
) 