Здравствуйте, форумчане. Столкнулся с очередной проблемой: Имею строку А1 c очень длинным текстом на одном листе и 4 строки А5 (~40 символов); В1(~85 символов); С1(~85 символов); D1(~85 символов) Стоит задача перенести текст с первого листа во второй по указанному условию. С тремя строками получается, с четырьмя никак. Может кто подскажет как должен выглядеть код.
Здравствуйте, форумчане. Столкнулся с очередной проблемой: Имею строку А1 c очень длинным текстом на одном листе и 4 строки А5 (~40 символов); В1(~85 символов); С1(~85 символов); D1(~85 символов) Стоит задача перенести текст с первого листа во второй по указанному условию. С тремя строками получается, с четырьмя никак. Может кто подскажет как должен выглядеть код.Webbear
Webbear, привет что если вот так вот, например: [vba]
Код
Sub ttt() Dim s$, sp, i&, k&, tmpS$, arr s = Sheets("Основные параметры").Range("A6").Value 'N24 - 56 символов, A26 - 97 символов и т.д. arr = Array(56, "N24", 97, "A26", 97, "A28", 97, "A30") sp = Split(s) For i = 0 To UBound(sp) tmpS = tmpS & " " & sp(i) If Len(tmpS) > arr(k) Then Sheets("ШАБЛОН").Range(arr(k + 1)).Value = Mid(tmpS, 1, Len(tmpS) - Len(sp(i)) - 1) tmpS = sp(i) k = k + 2 If k > 6 Then MsgBox "Не вмещаемся!", 48: Exit Sub End If Next i Sheets("ШАБЛОН").Range(arr(k + 1)).Value = tmpS End Sub
[/vba]
Webbear, привет что если вот так вот, например: [vba]
Код
Sub ttt() Dim s$, sp, i&, k&, tmpS$, arr s = Sheets("Основные параметры").Range("A6").Value 'N24 - 56 символов, A26 - 97 символов и т.д. arr = Array(56, "N24", 97, "A26", 97, "A28", 97, "A30") sp = Split(s) For i = 0 To UBound(sp) tmpS = tmpS & " " & sp(i) If Len(tmpS) > arr(k) Then Sheets("ШАБЛОН").Range(arr(k + 1)).Value = Mid(tmpS, 1, Len(tmpS) - Len(sp(i)) - 1) tmpS = sp(i) k = k + 2 If k > 6 Then MsgBox "Не вмещаемся!", 48: Exit Sub End If Next i Sheets("ШАБЛОН").Range(arr(k + 1)).Value = tmpS End Sub
nilem, есть предложения как встроить ваш вариант в код файла, не могу сообразить, с какой стороны подступиться? И если можно, вкратце, опишите последовательность действий в вашем варианте. Я просто пытаюсь хоть немного разобраться в VBA, а начал только 3 дня назад
nilem, есть предложения как встроить ваш вариант в код файла, не могу сообразить, с какой стороны подступиться? И если можно, вкратце, опишите последовательность действий в вашем варианте. Я просто пытаюсь хоть немного разобраться в VBA, а начал только 3 дня назад Webbear
Sub SplitN(str$, n As Variant, ByRef rng As Range) Dim i%, j%, tmp$ For i = 0 To UBound(n) tmp$ = Mid(str, j + 1, InStrRev(Mid(str & " ", j + 1, n(i)), " ")) j = j + Len(tmp) rng.Areas(i + 1) = Application.Trim(tmp) Next End Sub
Sub SplitN(str$, n As Variant, ByRef rng As Range) Dim i%, j%, tmp$ For i = 0 To UBound(n) tmp$ = Mid(str, j + 1, InStrRev(Mid(str & " ", j + 1, n(i)), " ")) j = j + Len(tmp) rng.Areas(i + 1) = Application.Trim(tmp) Next End Sub
У вас там есть процедура Автозаполнение (разбираться долго). Вставьте предпоследней строкой Call ttt, вот так: [vba]
Код
..... Call ttt
Application.ScreenUpdating = True 'включаем обновление экрана End Sub
[/vba] А в стандартный модуль вставьте такую процедуру: [vba]
Код
Sub ttt() Dim s$, sp, i&, k&, tmpS$, arr s = Sheets("Основные параметры").Range("A6").Value 'N24 - 56 символов, A26 - 97 символов и т.д. arr = Array(56, "N24", 97, "A26", 97, "A28", 97, "A30") sp = Split(s) With ActiveSheet .Range("N24:AD24,A26:AD26,A28:AD28,A30:AD30").ClearContents For i = 0 To UBound(sp) tmpS = tmpS & " " & sp(i) If Len(tmpS) > arr(k) Then .Range(arr(k + 1)).Value = Mid(tmpS, 1, Len(tmpS) - Len(sp(i)) - 1) tmpS = sp(i) k = k + 2 If k > 6 Then MsgBox "Не вмещаемся!", 48: Exit Sub End If Next i .Range(arr(k + 1)).Value = tmpS End With End Sub
[/vba] У меня так работает
У вас там есть процедура Автозаполнение (разбираться долго). Вставьте предпоследней строкой Call ttt, вот так: [vba]
Код
..... Call ttt
Application.ScreenUpdating = True 'включаем обновление экрана End Sub
[/vba] А в стандартный модуль вставьте такую процедуру: [vba]
Код
Sub ttt() Dim s$, sp, i&, k&, tmpS$, arr s = Sheets("Основные параметры").Range("A6").Value 'N24 - 56 символов, A26 - 97 символов и т.д. arr = Array(56, "N24", 97, "A26", 97, "A28", 97, "A30") sp = Split(s) With ActiveSheet .Range("N24:AD24,A26:AD26,A28:AD28,A30:AD30").ClearContents For i = 0 To UBound(sp) tmpS = tmpS & " " & sp(i) If Len(tmpS) > arr(k) Then .Range(arr(k + 1)).Value = Mid(tmpS, 1, Len(tmpS) - Len(sp(i)) - 1) tmpS = sp(i) k = k + 2 If k > 6 Then MsgBox "Не вмещаемся!", 48: Exit Sub End If Next i .Range(arr(k + 1)).Value = tmpS End With End Sub
krosav4ig, прошу прощения, видимо вчера подустал и перемудрил с вашим кодом. Сегодня со свежими силами заново все прописал внимательно и все сработало без танцев с бубнами. Спасибо!
....показалось мне на первый взгляд, но : У меня данные правильно вписываются в сам "Шаблон"!!! и в первый акт, а со второго начинаются косяки.
У вас там есть процедура Автозаполнение (разбираться долго). Вставьте предпоследней строкой Call ttt,
Как только удаляю эту строку, все становится нормально на всех страницах.
krosav4ig, прошу прощения, видимо вчера подустал и перемудрил с вашим кодом. Сегодня со свежими силами заново все прописал внимательно и все сработало без танцев с бубнами. Спасибо!
....показалось мне на первый взгляд, но : У меня данные правильно вписываются в сам "Шаблон"!!! и в первый акт, а со второго начинаются косяки.
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
