Вот есть, построчные текстовые записи в файле txt Их нужно вставить на лист3 экселя. Но вставить нужно не все, а только те текстовые строки, которые построчно идут после надписи "РАЗДЕЛИТЕЛЬ ТЕКСТА" - в этом текстовом файле.
Как такое макросом реализовать ?
Доброго времени. У меня такой вопрос.
Вот есть, построчные текстовые записи в файле txt Их нужно вставить на лист3 экселя. Но вставить нужно не все, а только те текстовые строки, которые построчно идут после надписи "РАЗДЕЛИТЕЛЬ ТЕКСТА" - в этом текстовом файле.
Не очень понятна фраза "те текстовые строки, которые построчно идут после надписи "РАЗДЕЛИТЕЛЬ ТЕКСТА"". Покажите в экселевском файле, что и куда нужно вставить.
Не очень понятна фраза "те текстовые строки, которые построчно идут после надписи "РАЗДЕЛИТЕЛЬ ТЕКСТА"". Покажите в экселевском файле, что и куда нужно вставить.StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
вот вам не понятный макрос по не понятному условию [vba]
Код
Sub readtxt() Dim FileNameTxt$: FileNameTxt = "Полный путь к вашему текстовому файлу" Dim meData(), i&, sStr$ Dim filenum&: filenum = FreeFile() Open FileNameTxt For Input As #filenum Do Until EOF(filenum) Line Input #filenum, sStr If InStr(1, sStr, "РАЗДЕЛИТЕЛЬ ТЕКСТА") Then 'если нашли строку то, что-то выполняем Do 'например, считываем в массив Line Input #filenum, sStr i = i + 1 ReDim Preserve meData(1 To i) meData(i) = sStr If EOF(filenum) Then GoTo ExitSub 'если конец файла, то выходим Loop While InStr(1, sStr, "РАЗДЕЛИТЕЛЬ ТЕКСТА") = 0 'находим следующее вхождение - выходим, а может вам что-то другое надо... i = i - 1 ReDim Preserve meData(1 To i) End If Loop ExitSub: Close #filenum ActiveSheet.Range(Cells(1, 1), Cells(UBound(meData), 1)) = Application.Transpose(meData) 'выводим массив на активный лист End Sub
[/vba]
вот вам не понятный макрос по не понятному условию [vba]
Код
Sub readtxt() Dim FileNameTxt$: FileNameTxt = "Полный путь к вашему текстовому файлу" Dim meData(), i&, sStr$ Dim filenum&: filenum = FreeFile() Open FileNameTxt For Input As #filenum Do Until EOF(filenum) Line Input #filenum, sStr If InStr(1, sStr, "РАЗДЕЛИТЕЛЬ ТЕКСТА") Then 'если нашли строку то, что-то выполняем Do 'например, считываем в массив Line Input #filenum, sStr i = i + 1 ReDim Preserve meData(1 To i) meData(i) = sStr If EOF(filenum) Then GoTo ExitSub 'если конец файла, то выходим Loop While InStr(1, sStr, "РАЗДЕЛИТЕЛЬ ТЕКСТА") = 0 'находим следующее вхождение - выходим, а может вам что-то другое надо... i = i - 1 ReDim Preserve meData(1 To i) End If Loop ExitSub: Close #filenum ActiveSheet.Range(Cells(1, 1), Cells(UBound(meData), 1)) = Application.Transpose(meData) 'выводим массив на активный лист End Sub
Sub readtxt() Dim FileNameTxt$: FileNameTxt = "Полный путь к вашему текстовому файлу" Dim meData(), i&, sStr$ Dim filenum&: filenum = FreeFile() Open FileNameTxt For Input As #filenum Do Until EOF(filenum) Line Input #filenum, sStr If InStr(1, sStr, "РАЗДЕЛИТЕЛЬ ТЕКСТА") Then 'если нашли строку то, что-то выполняем Do 'например, считываем в массив 10 Line Input #filenum, sStr i = i + 1 ReDim Preserve meData(1 To i) meData(i) = sStr If EOF(filenum) Then GoTo ExitSub 'если конец файла, то выходим Loop While InStr(1, sStr, "РАЗДЕЛИТЕЛЬ ТЕКСТА") = 0 'находим следующее вхождение - выходим, а может вам что-то другое надо... i = 0 ReDim meData(1 To 1) GoTo 10 End If Loop ExitSub: Close #filenum ActiveSheet.Range(Cells(1, 1), Cells(UBound(meData), 1)) = Application.Transpose(meData) 'выводим массив на активный лист End Sub
Sub readtxt() Dim FileNameTxt$: FileNameTxt = "Полный путь к вашему текстовому файлу" Dim meData(), i&, sStr$ Dim filenum&: filenum = FreeFile() Open FileNameTxt For Input As #filenum Do Until EOF(filenum) Line Input #filenum, sStr If InStr(1, sStr, "РАЗДЕЛИТЕЛЬ ТЕКСТА") Then 'если нашли строку то, что-то выполняем Do 'например, считываем в массив 10 Line Input #filenum, sStr i = i + 1 ReDim Preserve meData(1 To i) meData(i) = sStr If EOF(filenum) Then GoTo ExitSub 'если конец файла, то выходим Loop While InStr(1, sStr, "РАЗДЕЛИТЕЛЬ ТЕКСТА") = 0 'находим следующее вхождение - выходим, а может вам что-то другое надо... i = 0 ReDim meData(1 To 1) GoTo 10 End If Loop ExitSub: Close #filenum ActiveSheet.Range(Cells(1, 1), Cells(UBound(meData), 1)) = Application.Transpose(meData) 'выводим массив на активный лист End Sub