Здравствуйте! Есть необходимость создания программ для оборудования с числовым программным управлением в excel. Смысл в такой: я в Excel создал шаблон программы. В этой программе есть подпрограммы. Каждая подпрограмма это текстовый файл большого размера, расположенный в определенной папке. Excel к сожалению не может свободно работать с большими текстами. Здесь планируется использовать, либо ссылку на эти подпрограммы, либо некую функцию копируя текст каждой подпрограммы не загружая его в ексель. После необходимо сохранить все в обычном формате txt. По факту, как я делаю все это сейчас: создаю шаблон в excel (он от каждой новой задачи будет новый), копирую все это дело в обычный блокнот виндоус, открываю вторым блокнотом файл подпрогаммы, копирую там все, вставляю в первый блокнот. И так далее. Когда таких подпрограмм, скажем до 5 это еще терпимо, но когда их 20, 30, 50, тут уже велик шанс ошибиться. Да и вообще это муторно делать в блокноте. Конечный результат файла программы может быть легко и 50 мб и 80 мб. Обычный блокнот с этим справляется шутя, а вот ексель задумывается и не разбудишь. Есть ли возможность как то использовать Excel для данного дела? Прикладываю скан рабочего стола:
Здравствуйте! Есть необходимость создания программ для оборудования с числовым программным управлением в excel. Смысл в такой: я в Excel создал шаблон программы. В этой программе есть подпрограммы. Каждая подпрограмма это текстовый файл большого размера, расположенный в определенной папке. Excel к сожалению не может свободно работать с большими текстами. Здесь планируется использовать, либо ссылку на эти подпрограммы, либо некую функцию копируя текст каждой подпрограммы не загружая его в ексель. После необходимо сохранить все в обычном формате txt. По факту, как я делаю все это сейчас: создаю шаблон в excel (он от каждой новой задачи будет новый), копирую все это дело в обычный блокнот виндоус, открываю вторым блокнотом файл подпрогаммы, копирую там все, вставляю в первый блокнот. И так далее. Когда таких подпрограмм, скажем до 5 это еще терпимо, но когда их 20, 30, 50, тут уже велик шанс ошибиться. Да и вообще это муторно делать в блокноте. Конечный результат файла программы может быть легко и 50 мб и 80 мб. Обычный блокнот с этим справляется шутя, а вот ексель задумывается и не разбудишь. Есть ли возможность как то использовать Excel для данного дела? Прикладываю скан рабочего стола: Roman1
копирую ... в обычный блокнот виндоус,..., копирую ... вставляю в первый блокнот.
то excel справится и подавно - у меня текстовые файлы весили за 300мб - там блокнот умирал, можно было открыть только Notepad ++. Excel даже не подумал виснуть . Суть работы. Открыть главный файл для записи. потом открывать поочередно все файлы, которые нужно собрать - обрабатываете и записываете и закрываете их. закрыть файл для записи Размер значения не имеет. (По крайней мере я в потолок не уперся)
копирую ... в обычный блокнот виндоус,..., копирую ... вставляю в первый блокнот.
то excel справится и подавно - у меня текстовые файлы весили за 300мб - там блокнот умирал, можно было открыть только Notepad ++. Excel даже не подумал виснуть . Суть работы. Открыть главный файл для записи. потом открывать поочередно все файлы, которые нужно собрать - обрабатываете и записываете и закрываете их. закрыть файл для записи Размер значения не имеет. (По крайней мере я в потолок не уперся)SLAVICK
Скажите, пожалуйста, есть ли такая возможность: там где мне нужно вставить текст подпрограммы, я даю ссылку на внешний файл. Это нужно для того что б не запутаться в строках и работать только наглядно ссылками, что бы не допускать ошибок. После неким, допустим макросом, сохранять все это добро в формат тхт, но с заменой ссылок на соответствующий текст в этих ссылочных файлах?
Спасибо за ответ!
Скажите, пожалуйста, есть ли такая возможность: там где мне нужно вставить текст подпрограммы, я даю ссылку на внешний файл. Это нужно для того что б не запутаться в строках и работать только наглядно ссылками, что бы не допускать ошибок. После неким, допустим макросом, сохранять все это добро в формат тхт, но с заменой ссылок на соответствующий текст в этих ссылочных файлах?Roman1
Догадываюсь(поскольку живых примеров нет), что есть. Почитайте для старта тут и тут. Если не выйдет - готовьте живые примеры, с пояснениями что куда и зачем.
Догадываюсь(поскольку живых примеров нет), что есть. Почитайте для старта тут и тут. Если не выйдет - готовьте живые примеры, с пояснениями что куда и зачем.SLAVICK
К сожалению, ссылки не помогли. Выкладываю пример в папке с пояснениями. Главная загвоздка не в сохранении в txt, а в "вытаскивание" информации из файлов, которые в ексель-файле даны гиперссылками. Спасибо!
К сожалению, ссылки не помогли. Выкладываю пример в папке с пояснениями. Главная загвоздка не в сохранении в txt, а в "вытаскивание" информации из файлов, которые в ексель-файле даны гиперссылками. Спасибо!Roman1
Чет на какой-то глюк наткнулся при считывании 1 файла, первая строка получается яюG0Z50.000. Откуда яю берётся непонятно. [vba]
Код
Option Explicit
Public Sub test() Dim str1 As String
str1 = "Подпрограмма 1.nc" str1 = ThisWorkbook.Path & "/" & str1 Open str1 For Input As #2 Line Input #2, str1 Debug.Print str1 Close #2 End Sub
[/vba] Остальное нормально отрабатывает
[vba]
Код
Option Explicit
Const NOTHYP As String = "В ячейке нет гиперссылки!"
Private Function getHyperlinkAddress(ByVal rCell As Range) As String Dim s As String If rCell.Hyperlinks.Count = 0 Then If Mid$(rCell.Formula, 2, 9) = "HYPERLINK" Then getHyperlinkAddress = Mid$(rCell.Formula, 13, InStr(13, rCell.Formula, Chr(34)) - 13) Else getHyperlinkAddress = NOTHYP End If Else s = rCell.Hyperlinks(1).SubAddress If s <> "" Then s = "#" & rCell.Hyperlinks(1).SubAddress getHyperlinkAddress = rCell.Hyperlinks(rCell.Hyperlinks.Count).Address & s End If End Function
''===
Public Sub main() Dim rowLast As Long, i& Dim str1 As String Const outFile As String = "resultat.nc"
str1 = ThisWorkbook.Path & "/" & outFile Open str1 For Output As #1 rowLast = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row With ActiveSheet For i = 1 To rowLast str1 = getHyperlinkAddress(ActiveSheet.Range("A" & i))
If str1 <> NOTHYP Then str1 = ThisWorkbook.Path & "/" & str1 Open str1 For Input As #2 Do While Not EOF(2) Line Input #2, str1 If Not EOF(2) Then Print #1, str1 Loop Close #2 Else str1 = .Cells(i, 1).Value If .Cells(i, 2).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 2).Value If .Cells(i, 3).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 3).Value End If End If Print #1, str1 End If Next i End With Close #1 End Sub
[/vba]
Чет на какой-то глюк наткнулся при считывании 1 файла, первая строка получается яюG0Z50.000. Откуда яю берётся непонятно. [vba]
Код
Option Explicit
Public Sub test() Dim str1 As String
str1 = "Подпрограмма 1.nc" str1 = ThisWorkbook.Path & "/" & str1 Open str1 For Input As #2 Line Input #2, str1 Debug.Print str1 Close #2 End Sub
[/vba] Остальное нормально отрабатывает
[vba]
Код
Option Explicit
Const NOTHYP As String = "В ячейке нет гиперссылки!"
Private Function getHyperlinkAddress(ByVal rCell As Range) As String Dim s As String If rCell.Hyperlinks.Count = 0 Then If Mid$(rCell.Formula, 2, 9) = "HYPERLINK" Then getHyperlinkAddress = Mid$(rCell.Formula, 13, InStr(13, rCell.Formula, Chr(34)) - 13) Else getHyperlinkAddress = NOTHYP End If Else s = rCell.Hyperlinks(1).SubAddress If s <> "" Then s = "#" & rCell.Hyperlinks(1).SubAddress getHyperlinkAddress = rCell.Hyperlinks(rCell.Hyperlinks.Count).Address & s End If End Function
''===
Public Sub main() Dim rowLast As Long, i& Dim str1 As String Const outFile As String = "resultat.nc"
str1 = ThisWorkbook.Path & "/" & outFile Open str1 For Output As #1 rowLast = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row With ActiveSheet For i = 1 To rowLast str1 = getHyperlinkAddress(ActiveSheet.Range("A" & i))
If str1 <> NOTHYP Then str1 = ThisWorkbook.Path & "/" & str1 Open str1 For Input As #2 Do While Not EOF(2) Line Input #2, str1 If Not EOF(2) Then Print #1, str1 Loop Close #2 Else str1 = .Cells(i, 1).Value If .Cells(i, 2).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 2).Value If .Cells(i, 3).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 3).Value End If End If Print #1, str1 End If Next i End With Close #1 End Sub
Разобрался с глюком. Файл в кодировке UCS-2 Little Endian, перевел в ANSI и всё стало нормально. Чуток код изменил [vba]
Код
Option Explicit
Const NOTHYP As String = "В ячейке нет гиперссылки!"
Private Function getHyperlinkAddress(ByVal rCell As Range) As String Dim S As String If rCell.Hyperlinks.Count = 0 Then If Mid$(rCell.Formula, 2, 9) = "HYPERLINK" Then getHyperlinkAddress = Mid$(rCell.Formula, 13, InStr(13, rCell.Formula, Chr(34)) - 13) Else getHyperlinkAddress = NOTHYP End If Else S = rCell.Hyperlinks(1).SubAddress If S <> "" Then S = "#" & rCell.Hyperlinks(1).SubAddress getHyperlinkAddress = rCell.Hyperlinks(rCell.Hyperlinks.Count).Address & S End If End Function
''===
Public Sub main() Dim rowLast As Long, i& Dim str1 As String Const outFile As String = "resultat.nc"
str1 = ThisWorkbook.Path & "/" & outFile Open str1 For Output As #1 rowLast = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row With ThisWorkbook.ActiveSheet For i = 1 To rowLast str1 = getHyperlinkAddress(ActiveSheet.Range("A" & i))
If str1 <> NOTHYP Then str1 = ThisWorkbook.Path & "/" & str1 If Dir(str1) = "" Then Close #1 MsgBox "Не найден файл " & str1 & ". Макрос остановлен", 48, "Файл отсутствует " Exit Sub End If Open str1 For Input As #2 Do While Not EOF(2) Line Input #2, str1 If Not EOF(2) Then Print #1, str1 Loop Close #2 Else str1 = .Cells(i, 1).Value If .Cells(i, 2).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 2).Value If .Cells(i, 3).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 3).Value End If End If Print #1, str1 End If Next i End With Close #1 End Sub
[/vba]
Разобрался с глюком. Файл в кодировке UCS-2 Little Endian, перевел в ANSI и всё стало нормально. Чуток код изменил [vba]
Код
Option Explicit
Const NOTHYP As String = "В ячейке нет гиперссылки!"
Private Function getHyperlinkAddress(ByVal rCell As Range) As String Dim S As String If rCell.Hyperlinks.Count = 0 Then If Mid$(rCell.Formula, 2, 9) = "HYPERLINK" Then getHyperlinkAddress = Mid$(rCell.Formula, 13, InStr(13, rCell.Formula, Chr(34)) - 13) Else getHyperlinkAddress = NOTHYP End If Else S = rCell.Hyperlinks(1).SubAddress If S <> "" Then S = "#" & rCell.Hyperlinks(1).SubAddress getHyperlinkAddress = rCell.Hyperlinks(rCell.Hyperlinks.Count).Address & S End If End Function
''===
Public Sub main() Dim rowLast As Long, i& Dim str1 As String Const outFile As String = "resultat.nc"
str1 = ThisWorkbook.Path & "/" & outFile Open str1 For Output As #1 rowLast = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row With ThisWorkbook.ActiveSheet For i = 1 To rowLast str1 = getHyperlinkAddress(ActiveSheet.Range("A" & i))
If str1 <> NOTHYP Then str1 = ThisWorkbook.Path & "/" & str1 If Dir(str1) = "" Then Close #1 MsgBox "Не найден файл " & str1 & ". Макрос остановлен", 48, "Файл отсутствует " Exit Sub End If Open str1 For Input As #2 Do While Not EOF(2) Line Input #2, str1 If Not EOF(2) Then Print #1, str1 Loop Close #2 Else str1 = .Cells(i, 1).Value If .Cells(i, 2).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 2).Value If .Cells(i, 3).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 3).Value End If End If Print #1, str1 End If Next i End With Close #1 End Sub
Протестировал на рабочих делах с большими файлами. Столкнулся с первой проблемой: Почему с подпрограмм не выводит последнюю строчку. Пробовал в разных вариациях. Это забавно, т.к. мне последнии две строчки и не нужны, т.к. они отключают вращение шпинделя. Но хотелось бы понять из-за чего это и как тогда убрать и предпоследнюю строчку (раз уж коснулись этого вопроса, как убрать и первую строку, она отвечает за начало программы).
Вторая проблема: Все работает на ура, когда все подпрограммы находятся в той же папке, что и ексель файл. Пробую вставлять гиперссылки на подпрограммы с их правильного местонахождения - ошибка. И работает все только когда название файла "Подпрограмма ...". Возможно сделать произвольное название? Информацию брать с файла с гиперссылки из любого места на диске и с произвольным названием файла?
В макросах не силен, не могу понять что не так (работаю по мелочи с макросами, без них никуда, но тут все новые функции для меня).
Спасибо!
Протестировал на рабочих делах с большими файлами. Столкнулся с первой проблемой: Почему с подпрограмм не выводит последнюю строчку. Пробовал в разных вариациях. Это забавно, т.к. мне последнии две строчки и не нужны, т.к. они отключают вращение шпинделя. Но хотелось бы понять из-за чего это и как тогда убрать и предпоследнюю строчку (раз уж коснулись этого вопроса, как убрать и первую строку, она отвечает за начало программы).
Вторая проблема: Все работает на ура, когда все подпрограммы находятся в той же папке, что и ексель файл. Пробую вставлять гиперссылки на подпрограммы с их правильного местонахождения - ошибка. И работает все только когда название файла "Подпрограмма ...". Возможно сделать произвольное название? Информацию брать с файла с гиперссылки из любого места на диске и с произвольным названием файла?
В макросах не силен, не могу понять что не так (работаю по мелочи с макросами, без них никуда, но тут все новые функции для меня).
се работает на ура, когда все подпрограммы находятся в той же папке
Хы, я именно на это и расчитывал. К имени файла добавляется путь к текущей папке, поэтому ерунда выходит когда файл в другой. Посмотрю что можно сделать.
се работает на ура, когда все подпрограммы находятся в той же папке
Хы, я именно на это и расчитывал. К имени файла добавляется путь к текущей папке, поэтому ерунда выходит когда файл в другой. Посмотрю что можно сделать.Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
Const NOTHYP As String = "В ячейке нет гиперссылки!"
Private Function getHyperlinkAddress(ByVal rCell As Range) As String Dim S As String If rCell.Hyperlinks.Count = 0 Then If Mid$(rCell.Formula, 2, 9) = "HYPERLINK" Then getHyperlinkAddress = Mid$(rCell.Formula, 13, InStr(13, rCell.Formula, Chr(34)) - 13) Else getHyperlinkAddress = NOTHYP End If Else S = rCell.Hyperlinks(1).SubAddress If S <> "" Then S = "#" & rCell.Hyperlinks(1).SubAddress getHyperlinkAddress = rCell.Hyperlinks(rCell.Hyperlinks.Count).Address & S End If End Function
''===
Public Sub main() Dim rowLast As Long, i& Dim str1 As String Const outFile As String = "resultat.nc"
str1 = ThisWorkbook.Path & "/" & outFile Open str1 For Output As #1 rowLast = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row With ThisWorkbook.ActiveSheet For i = 1 To rowLast str1 = getHyperlinkAddress(ActiveSheet.Range("A" & i))
If str1 <> NOTHYP Then If InStr(str1, ":\") = 0 Then str1 = ThisWorkbook.Path & "/" & str1 End If If Dir(str1) = "" Then Close #1 MsgBox "Не найден файл " & str1 & ". Макрос остановлен", 48, "Файл отсутствует " Exit Sub End If Open str1 For Input As #2 Do While Not EOF(2) Line Input #2, str1 If (str1 = "") And (EOF(2)) Then Else Print #1, str1 End If Loop Close #2 Else str1 = .Cells(i, 1).Value If .Cells(i, 2).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 2).Value If .Cells(i, 3).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 3).Value End If End If Print #1, str1 End If Next i End With Close #1 End Sub
[/vba]
Исправленный вариант [vba]
Код
Option Explicit
Const NOTHYP As String = "В ячейке нет гиперссылки!"
Private Function getHyperlinkAddress(ByVal rCell As Range) As String Dim S As String If rCell.Hyperlinks.Count = 0 Then If Mid$(rCell.Formula, 2, 9) = "HYPERLINK" Then getHyperlinkAddress = Mid$(rCell.Formula, 13, InStr(13, rCell.Formula, Chr(34)) - 13) Else getHyperlinkAddress = NOTHYP End If Else S = rCell.Hyperlinks(1).SubAddress If S <> "" Then S = "#" & rCell.Hyperlinks(1).SubAddress getHyperlinkAddress = rCell.Hyperlinks(rCell.Hyperlinks.Count).Address & S End If End Function
''===
Public Sub main() Dim rowLast As Long, i& Dim str1 As String Const outFile As String = "resultat.nc"
str1 = ThisWorkbook.Path & "/" & outFile Open str1 For Output As #1 rowLast = ThisWorkbook.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row With ThisWorkbook.ActiveSheet For i = 1 To rowLast str1 = getHyperlinkAddress(ActiveSheet.Range("A" & i))
If str1 <> NOTHYP Then If InStr(str1, ":\") = 0 Then str1 = ThisWorkbook.Path & "/" & str1 End If If Dir(str1) = "" Then Close #1 MsgBox "Не найден файл " & str1 & ". Макрос остановлен", 48, "Файл отсутствует " Exit Sub End If Open str1 For Input As #2 Do While Not EOF(2) Line Input #2, str1 If (str1 = "") And (EOF(2)) Then Else Print #1, str1 End If Loop Close #2 Else str1 = .Cells(i, 1).Value If .Cells(i, 2).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 2).Value If .Cells(i, 3).Value <> "" Then str1 = str1 & vbTab & .Cells(i, 3).Value End If End If Print #1, str1 End If Next i End With Close #1 End Sub
А есть ли возможность добавить диапазон работы данного макроса? Это необходимо для внедрения макроса в уже существующий файл эксель, т.к. на этом же файле много других необходимых данных для автоматической генерации координат и их нет возможности перенести на другой лист.
А есть ли возможность добавить диапазон работы данного макроса? Это необходимо для внедрения макроса в уже существующий файл эксель, т.к. на этом же файле много других необходимых данных для автоматической генерации координат и их нет возможности перенести на другой лист.Roman1
Udik, Спасибо еще раз огромное за помощь! Я сейчас сильно продвинулся в этом направлении (написании управляющих программ). Осталось несколько вопросов, которые я к сожалению не могу сам решить (пробовал по разному, не вышло): 1. В оригинале файла не три столбца, а пять. Не получилось изменить макрос на обработку пяти первых столбцов; 2. Есть ли все же возможность ограничить диапазон работы макроса? В моем конкретном случае используется диапазон: D1:H500. 3. Есть ли возможность удаления двух последних строк в каждой подгружаемой подпрограммы с гиперссылки. Это нужно, т.к. последнии две строки отвечают за отключение шпинделя, а это разумеется не нужно.
Спасибо!
Udik, Спасибо еще раз огромное за помощь! Я сейчас сильно продвинулся в этом направлении (написании управляющих программ). Осталось несколько вопросов, которые я к сожалению не могу сам решить (пробовал по разному, не вышло): 1. В оригинале файла не три столбца, а пять. Не получилось изменить макрос на обработку пяти первых столбцов; 2. Есть ли все же возможность ограничить диапазон работы макроса? В моем конкретном случае используется диапазон: D1:H500. 3. Есть ли возможность удаления двух последних строк в каждой подгружаемой подпрограммы с гиперссылки. Это нужно, т.к. последнии две строки отвечают за отключение шпинделя, а это разумеется не нужно.
Есть ли возможность удаления двух последних строк в каждой подгружаемой подпрограммы с гиперссылки
Если строки одинаковые, то можно просто проверку добавить и пропускать ненужные. == Посмотрел сейчас файлики подпрограмм - везде последние строки разные. Или эти файлики тоже не совсем рабочие?
Есть ли возможность удаления двух последних строк в каждой подгружаемой подпрограммы с гиперссылки
Если строки одинаковые, то можно просто проверку добавить и пропускать ненужные. == Посмотрел сейчас файлики подпрограмм - везде последние строки разные. Или эти файлики тоже не совсем рабочие?Udik
вот вам барабан яд 41001231307558 wm R419131876897 udik1968@gmail.com
Сообщение отредактировал Udik - Вторник, 18.04.2017, 21:15
Public Sub main() Dim rowLast As Long, i&, rowStart& Dim clnStart As Byte Dim str1 As String Const outFile As String = "resultat.nc"
str1 = ThisWorkbook.Path & "/" & outFile Open str1 For Output As #1 With ThisWorkbook.ActiveSheet rowLast = .Cells(Rows.Count, 4).End(xlUp).Row rowStart = 0 clnStart = 4 For i = 1 To 100 If .Cells(i, clnStart).Text = "%" Then rowStart = i Exit For End If Next i If rowStart = 0 Then MsgBox "В первых 100 строках не найдена ячейка, равная %. Макрос остановлен.", 48, "Не найдено" Close #1 Exit Sub
End If For i = 1 To rowLast str1 = getHyperlinkAddress(.Range(.Cells(i, clnStart).Address))
If str1 <> NOTHYP Then If InStr(str1, ":\") = 0 Then str1 = ThisWorkbook.Path & "/" & str1 End If If Dir(str1) = "" Then Close #1 MsgBox "Не найден файл " & str1 & ". Макрос остановлен", 48, "Файл отсутствует " Exit Sub End If Open str1 For Input As #2 Do While Not EOF(2) Line Input #2, str1 If (str1 = "") And (EOF(2)) Then Else If (str1 <> "M05") And (str1 <> "M30") Then Print #1, str1 End If End If Loop Close #2 Else str1 = .Cells(i, clnStart).Value If .Cells(i, clnStart + 1).Value <> "" Then str1 = str1 & vbTab & .Cells(i, clnStart + 1).Value If .Cells(i, clnStart + 2).Value <> "" Then str1 = str1 & vbTab & .Cells(i, clnStart + 2).Value If .Cells(i, clnStart + 3).Value <> "" Then str1 = str1 & vbTab & .Cells(i, clnStart + 3).Value If .Cells(i, clnStart + 4).Value <> "" Then str1 = str1 & vbTab & .Cells(i, clnStart + 4).Value End If End If End If End If Print #1, str1 End If Next i End With Close #1 End Sub
[/vba]
Надеюсь строки M05 M30 в середине подпрограмм не встречаются, а то сюрприз будет
Вот подрихтовал код
[vba]
Код
Public Sub main() Dim rowLast As Long, i&, rowStart& Dim clnStart As Byte Dim str1 As String Const outFile As String = "resultat.nc"
str1 = ThisWorkbook.Path & "/" & outFile Open str1 For Output As #1 With ThisWorkbook.ActiveSheet rowLast = .Cells(Rows.Count, 4).End(xlUp).Row rowStart = 0 clnStart = 4 For i = 1 To 100 If .Cells(i, clnStart).Text = "%" Then rowStart = i Exit For End If Next i If rowStart = 0 Then MsgBox "В первых 100 строках не найдена ячейка, равная %. Макрос остановлен.", 48, "Не найдено" Close #1 Exit Sub
End If For i = 1 To rowLast str1 = getHyperlinkAddress(.Range(.Cells(i, clnStart).Address))
If str1 <> NOTHYP Then If InStr(str1, ":\") = 0 Then str1 = ThisWorkbook.Path & "/" & str1 End If If Dir(str1) = "" Then Close #1 MsgBox "Не найден файл " & str1 & ". Макрос остановлен", 48, "Файл отсутствует " Exit Sub End If Open str1 For Input As #2 Do While Not EOF(2) Line Input #2, str1 If (str1 = "") And (EOF(2)) Then Else If (str1 <> "M05") And (str1 <> "M30") Then Print #1, str1 End If End If Loop Close #2 Else str1 = .Cells(i, clnStart).Value If .Cells(i, clnStart + 1).Value <> "" Then str1 = str1 & vbTab & .Cells(i, clnStart + 1).Value If .Cells(i, clnStart + 2).Value <> "" Then str1 = str1 & vbTab & .Cells(i, clnStart + 2).Value If .Cells(i, clnStart + 3).Value <> "" Then str1 = str1 & vbTab & .Cells(i, clnStart + 3).Value If .Cells(i, clnStart + 4).Value <> "" Then str1 = str1 & vbTab & .Cells(i, clnStart + 4).Value End If End If End If End If Print #1, str1 End If Next i End With Close #1 End Sub
[/vba]
Надеюсь строки M05 M30 в середине подпрограмм не встречаются, а то сюрприз будет Udik
Это просто невероятно! Спасибо огромное, вы Мастер!
Столкнулся с двумя проблемами: 1. Почему то "%" не убирает с подпрограмм, хотя в коде это прописано. М05 и М30 убирает. 2. Макрос почему то считывает и скрытые строки. В моем рабочем файле множество строк, которые редко используются, я их скрываю другим макросом, банально в столбце А на всех строках есть соответсвующий символ +/-. Минус разумеется не отображает всю строку (скрывает). Есть ли возможность не считывать скрытые строки? Если нет такой возможности, то не считывать строки, где в столбце А "-".
Извините за назойливость, но Победа близка! Спасибо еще раз Вам огромное!
Это просто невероятно! Спасибо огромное, вы Мастер!
Столкнулся с двумя проблемами: 1. Почему то "%" не убирает с подпрограмм, хотя в коде это прописано. М05 и М30 убирает. 2. Макрос почему то считывает и скрытые строки. В моем рабочем файле множество строк, которые редко используются, я их скрываю другим макросом, банально в столбце А на всех строках есть соответсвующий символ +/-. Минус разумеется не отображает всю строку (скрывает). Есть ли возможность не считывать скрытые строки? Если нет такой возможности, то не считывать строки, где в столбце А "-".
Извините за назойливость, но Победа близка! Спасибо еще раз Вам огромное!Roman1