есть лист с базой данных на человека, и есть лист с бланк-формой, которую нужно заполнить допустим на первом листе фамилия иванов, а на другом листе нужно раскидать И В А Н О В , ситуацию усугубляет то, что ячейки имеют разный размер, файл прилагается. выделено зеленым!
я смогла это сделать вручную, но похожих бланков разной направленности нужно еще много заполнить. хотелось бы узнать менее временезатратный способ. спасибо
Добрый день,
есть лист с базой данных на человека, и есть лист с бланк-формой, которую нужно заполнить допустим на первом листе фамилия иванов, а на другом листе нужно раскидать И В А Н О В , ситуацию усугубляет то, что ячейки имеют разный размер, файл прилагается. выделено зеленым!
я смогла это сделать вручную, но похожих бланков разной направленности нужно еще много заполнить. хотелось бы узнать менее временезатратный способ. спасибоrosebud2602
SkyPro, так то они тут изменены)) была бы я оченьрада если б жители узбекистана были ивановыми петрами))) и с порядком 123456 в паспорте)) а можно чуть больше информации по поводу ""Менее затратный способ = макрос? "" как говориться, я только учусь))
SkyPro, так то они тут изменены)) была бы я оченьрада если б жители узбекистана были ивановыми петрами))) и с порядком 123456 в паспорте)) а можно чуть больше информации по поводу ""Менее затратный способ = макрос? "" как говориться, я только учусь))rosebud2602
Sub ssss() Dim x, i&, c&, l&, txt, resAr$(1 To 10000, 1 To 1000)
x = Selection(1).Resize(Selection.Rows.Count, 1).Value On Error Resume Next l = 0 If IsArray(x) Then For i = LBound(x) To UBound(x) txt = UCase(x(i, 1)) If Len(txt) > l Then l = Len(txt) For c = 1 To Len(txt) resAr(i, c) = Mid(txt, c, 1) Next Next Else txt = UCase(x) If Len(txt) > l Then l = Len(txt) For c = 1 To Len(txt) resAr(1, c) = Mid(txt, c, 1) Next End If Selection(1).Offset(0, 1).Resize(Selection.Rows.Count, l) = resAr End Sub
[/vba]
Выделяете ячейку, или несколько (только в одном столбце, иначе обработает только крайний левый, а информация в остальных будет уничтожена) и запускаете макрос.
Ну как-то так:[vba]
Код
Sub ssss() Dim x, i&, c&, l&, txt, resAr$(1 To 10000, 1 To 1000)
x = Selection(1).Resize(Selection.Rows.Count, 1).Value On Error Resume Next l = 0 If IsArray(x) Then For i = LBound(x) To UBound(x) txt = UCase(x(i, 1)) If Len(txt) > l Then l = Len(txt) For c = 1 To Len(txt) resAr(i, c) = Mid(txt, c, 1) Next Next Else txt = UCase(x) If Len(txt) > l Then l = Len(txt) For c = 1 To Len(txt) resAr(1, c) = Mid(txt, c, 1) Next End If Selection(1).Offset(0, 1).Resize(Selection.Rows.Count, l) = resAr End Sub
[/vba]
Выделяете ячейку, или несколько (только в одном столбце, иначе обработает только крайний левый, а информация в остальных будет уничтожена) и запускаете макрос.SkyPro
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
