В прикрепленном файле есть три листа и один макрос. 1-й лист - "так есть" 2-й лист - "так переносит макрос" 3-й лист - "так нужно"
В листе ТАК ЕСТЬ - исходный текст в ячейках столбца А начиная с А2 и до бесконечности; Нажав на выполнение макроса получим такой вид как на листе ТАК ПЕРЕНОСИТ МАКРОС - этот вид не устраивает. Что исправить в макросе, чтобы при его срабатывании перенос был бы как на листе ТАК НУЖНО.
Спасибо
Добрый день уважаемые!
В прикрепленном файле есть три листа и один макрос. 1-й лист - "так есть" 2-й лист - "так переносит макрос" 3-й лист - "так нужно"
В листе ТАК ЕСТЬ - исходный текст в ячейках столбца А начиная с А2 и до бесконечности; Нажав на выполнение макроса получим такой вид как на листе ТАК ПЕРЕНОСИТ МАКРОС - этот вид не устраивает. Что исправить в макросе, чтобы при его срабатывании перенос был бы как на листе ТАК НУЖНО.
Sub tt() Dim c, s$ For Each c In Selection.Cells s = c.Value s = Replace(s, Chr(160), " ") s = Trim(Split(s, ".")(1)) ReDim out(1 To 3) arr = Split(s, "—") out(3) = Trim(arr(1)) Select Case True Case Left(s, 4) = "die " Or Left(s, 4) = "der " Or Left(s, 4) = "das " out(1) = Left(s, 3) out(2) = Mid(arr(0), 5) Case Else out(2) = Trim(arr(0)) End Select c.Next.Resize(, 3) = out Next End Sub
[/vba] Там пробелы разные встречаются...
Добрый. Выделить эти 3 ячейки, выполнить [vba]
Код
Sub tt() Dim c, s$ For Each c In Selection.Cells s = c.Value s = Replace(s, Chr(160), " ") s = Trim(Split(s, ".")(1)) ReDim out(1 To 3) arr = Split(s, "—") out(3) = Trim(arr(1)) Select Case True Case Left(s, 4) = "die " Or Left(s, 4) = "der " Or Left(s, 4) = "das " out(1) = Left(s, 3) out(2) = Mid(arr(0), 5) Case Else out(2) = Trim(arr(0)) End Select c.Next.Resize(, 3) = out Next End Sub
дело в том, что когда выделяю ТРИ строки и выполняю макрос, то всё работает, но у меня не три строки, а 5000 строк… Поэтому я выделил весь столбец и получил ошибку.
дело в том, что когда выделяю ТРИ строки и выполняю макрос, то всё работает, но у меня не три строки, а 5000 строк… Поэтому я выделил весь столбец и получил ошибку.grh1
Vadym Gorokh
Сообщение отредактировал grh1 - Пятница, 01.11.2024, 00:14
grh1, это значит что пример не соответствует файлу. Дорабатывайте код - пусть сперва поищет точку, и если не найдёт - значит такую строку не нужно обрабатывать.
grh1, это значит что пример не соответствует файлу. Дорабатывайте код - пусть сперва поищет точку, и если не найдёт - значит такую строку не нужно обрабатывать.Hugo
grh1, ОК, так можно выделить целиком столбец. Главное чтоб там не было "левых" ячеек с точками. [vba]
Код
Sub tt() Dim r, c, s$
Set r = Intersect(Selection.Parent.UsedRange, Selection) For Each c In r.Cells s = c.Value If InStr(s, ".") Then s = Replace(s, Chr(160), " ") s = Trim(Split(s, ".")(1)) ReDim out(1 To 3) arr = Split(s, "—") out(3) = Trim(arr(1)) Select Case True Case Left(s, 4) = "die " Or Left(s, 4) = "der " Or Left(s, 4) = "das " out(1) = Left(s, 3) out(2) = Mid(arr(0), 5) Case Else out(2) = Trim(arr(0)) End Select c.Next.Resize(, 3) = out End If Next End Sub
[/vba]
grh1, ОК, так можно выделить целиком столбец. Главное чтоб там не было "левых" ячеек с точками. [vba]
Код
Sub tt() Dim r, c, s$
Set r = Intersect(Selection.Parent.UsedRange, Selection) For Each c In r.Cells s = c.Value If InStr(s, ".") Then s = Replace(s, Chr(160), " ") s = Trim(Split(s, ".")(1)) ReDim out(1 To 3) arr = Split(s, "—") out(3) = Trim(arr(1)) Select Case True Case Left(s, 4) = "die " Or Left(s, 4) = "der " Or Left(s, 4) = "das " out(1) = Left(s, 3) out(2) = Mid(arr(0), 5) Case Else out(2) = Trim(arr(0)) End Select c.Next.Resize(, 3) = out End If Next End Sub
Ну точка нужна только для того чтоб её отрезать. Вместе с числом, тут: [vba]
Код
s = Trim(Split(s, ".")(1))
[/vba] Если эту строку выкинуть, то будет работать с строками без чисел с точкой. Но! первый вариант кода, во втором ведь дорабатывал что по этой точке определяем нужные строки.
Ну точка нужна только для того чтоб её отрезать. Вместе с числом, тут: [vba]
Код
s = Trim(Split(s, ".")(1))
[/vba] Если эту строку выкинуть, то будет работать с строками без чисел с точкой. Но! первый вариант кода, во втором ведь дорабатывал что по этой точке определяем нужные строки.Hugo
Это значит что в этой строке (где ошибка) нет этого дефиса, значит нужно вернуть назад проверку точки, но заменить точку на дефис. Можно вообще отключить реакцию на ошибки, но я так делаю в крайнем случае.
Это значит что в этой строке (где ошибка) нет этого дефиса, значит нужно вернуть назад проверку точки, но заменить точку на дефис. Можно вообще отключить реакцию на ошибки, но я так делаю в крайнем случае.Hugo
1. вернул назад строки с if, заменив точку на тире - ошибка таже; 2. опять убрал строки с if, а в строке, которую Вы сказали убрать - заменил точку на тире - ошибка выделила эту строку.
Что делаю не так?
Hugo,
1. вернул назад строки с if, заменив точку на тире - ошибка таже; 2. опять убрал строки с if, а в строке, которую Вы сказали убрать - заменил точку на тире - ошибка выделила эту строку.
Тире в коде заменил на тире из ячейки, ну и убрал лишнюю строку (закомментировал). И вернул проверку, только на тире. Всё.
[vba]
Код
Sub tt() Dim r, c, s$
Set r = Intersect(Selection.Parent.UsedRange, Selection) For Each c In r.Cells s = c.Value If InStr(s, "-") Then s = Replace(s, Chr(160), " ") 's = Trim(Split(s, "-")(1)) ReDim out(1 To 3) arr = Split(s, "-") out(3) = Trim(arr(1)) Select Case True Case Left(s, 4) = "die " Or Left(s, 4) = "der " Or Left(s, 4) = "das " out(1) = Left(s, 3) out(2) = Mid(arr(0), 5) Case Else out(2) = Trim(arr(0)) End Select c.Next.Resize(, 3) = out End If Next End Sub
[/vba]
Тире в коде заменил на тире из ячейки, ну и убрал лишнюю строку (закомментировал). И вернул проверку, только на тире. Всё.
[vba]
Код
Sub tt() Dim r, c, s$
Set r = Intersect(Selection.Parent.UsedRange, Selection) For Each c In r.Cells s = c.Value If InStr(s, "-") Then s = Replace(s, Chr(160), " ") 's = Trim(Split(s, "-")(1)) ReDim out(1 To 3) arr = Split(s, "-") out(3) = Trim(arr(1)) Select Case True Case Left(s, 4) = "die " Or Left(s, 4) = "der " Or Left(s, 4) = "das " out(1) = Left(s, 3) out(2) = Mid(arr(0), 5) Case Else out(2) = Trim(arr(0)) End Select c.Next.Resize(, 3) = out End If Next End Sub
Если там будут встречаться разные эти тире - заменяйте их все на один, как в коде я это сделал с пробелами в строке s = Replace(s, Chr(160), " ") вот ниже или выше добавьте в код такую строку с заменой того тире на котором получите ошибку на то, с которым всё ОК.
Спокойной ночи. ))
Если там будут встречаться разные эти тире - заменяйте их все на один, как в коде я это сделал с пробелами в строке s = Replace(s, Chr(160), " ") вот ниже или выше добавьте в код такую строку с заменой того тире на котором получите ошибку на то, с которым всё ОК.
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
