Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Подскажите как разбить текс по ширене столбца / 12 сообщений из 12, страница 1 из 1
28.03.2012, 18:47
    #37728189
puma_q
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
Есть текст, например: Кран шаровой запорный, номинальный диаметр DN 100; номинальное давление PN 1,6 (МПа); тип присоединения к трубопроводу под приварку; класс герметичности А по ГОСТ 9544-05; под электропривод ЭПП-1800.F14.60.Т024-УХЛ1-а, с заводским антикоррозионным покрытием, сейсмостойкость С, климатическое исполнение ХЛ1 (t мин -60, t макс +40), присоединяемая труба 108х4, рабочая среда нефть. Установка подземно. Комплектность: с удлинителем штока 2,5 м.

Необходимо этот текст разбить по ширене (Columns("B:B").ColumnWidth = 65.71) столбца на несколько подстрок, чтобы каждая подстрака вставлялась в ячейку находящуюся ниже... См. файл...
...
Рейтинг: 0 / 0
28.03.2012, 18:53
    #37728197
R Dmitry
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
puma_q,

F1
Код: vbnet
1.
Justify
...
Рейтинг: 0 / 0
29.03.2012, 09:37
    #37728844
puma_q
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
Спасибо за подсказку, но:
1. Эта функция не работает с текстом более 255 символов :(.
2. Мне к тому же нужно что бы следующая подстрока вставлялась в добавленную строку, т.е. сначала определяем сколько получится подстрок, затем добавляем новые строки по количеству полученных подстрок и уже в эти добавленные строки заносим подстроки....

Каламбур какой то получился... :)
...
Рейтинг: 0 / 0
30.03.2012, 10:42
    #37730930
puma_q
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
Посмотрите что получилось... Но есть несколько нюансов:
1. Почему то всё равно не получается добиться переноса текста как в Excele (в ячейке A1)
2. Этот код не учитывает размера шрифта в ставляемой ячейки.... допустим размер изменимна 12 в ставляемой ячейки...

Как можно доработать этот код? Как можно определить ширину символа с учётом конкретного размера шрифта?
...
Рейтинг: 0 / 0
30.03.2012, 13:51
    #37731343
R Dmitry
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
puma_q,
очень приблизительно......
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Sub puma_q()
w = Int(Worksheets("Лист1").Columns("A:A").ColumnWidth)
s = Split(Cells(1, 1).Value, " ")
zz = Cells(1, 1).Font.Size
w = Int(w * 10 / zz)
For i = 0 To UBound(s)
If Len(s(i)) + Len(tt) < w Then tt = tt & s(i) & " " Else a = a & tt & vbTab: tt = ""
Next
a = Split(a & tt, vbTab)
[a3].Resize(UBound(a) + 1) = Application.Transpose(a)
End Sub

...
Рейтинг: 0 / 0
30.03.2012, 13:58
    #37731364
R Dmitry
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
Извиняюсь чуть строка неправильная...
Код: vbnet
1.
.......Else a = a & tt & vbTab: tt = s(i)
...
Рейтинг: 0 / 0
30.03.2012, 14:01
    #37731375
R Dmitry
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
Вот весь код
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Sub puma_q()
w = Int(Worksheets("Лист1").Columns("A:A").ColumnWidth)
s = Split(Cells(1, 1).Value, " ")
zz = Cells(1, 1).Font.Size
w = Int(w * 10 / zz)
For i = 0 To UBound(s)
If Len(s(i)) + Len(tt) < w Then tt = tt & s(i) & " " Else a = a & tt & vbTab: tt = s(i) & " "
Next
a = Split(a & tt, vbTab)
[a3].Resize(UBound(a) + 1) = Application.Transpose(a)
End Sub

...
Рейтинг: 0 / 0
30.03.2012, 14:23
    #37731436
R Dmitry
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
И еще поправочка маленькая

Код: vbnet
1.
w = Int(w * 11 / zz)



Так более точно.
...
Рейтинг: 0 / 0
30.03.2012, 14:46
    #37731489
puma_q
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
спасибо за помощь, но есть нюансик: не обрабатывается случай если длина одного слова больше ширины ячейки.....
...
Рейтинг: 0 / 0
30.03.2012, 14:56
    #37731518
R Dmitry
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
puma_q,
Ну не все же мне делать... пусть и Вам чего останеться
если длинна слова больше ширины ячейки , тогда чего делаем :))
...
Рейтинг: 0 / 0
30.03.2012, 15:40
    #37731645
puma_q
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
R Dmitry если длинна слова больше ширины ячейки , тогда чего делаем :))

Тогда берём количесвто символов равное ширины ячейки (сколько в ней может уместится), остальные переносим на новую строку.... Такой способ вроде в самой Excel сделан....
...
Рейтинг: 0 / 0
30.03.2012, 18:22
    #37732076
R Dmitry
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Подскажите как разбить текс по ширене столбца
puma_q,
Option Explicit
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
Sub test()
РазбивкаТекстаНаСтроки Cells(1, 1)
End Sub
Sub РазбивкаТекстаНаСтроки(SplitCell As Range)
Dim w&, ww&, zz&, s, a, i&, j&, tt$
w = Int(SplitCell.ColumnWidth)
s = Split(SplitCell.Cells(1).Value, " ")
zz = SplitCell.Cells(1).Font.Size
w = Int(w * 11 / zz)
    For i = 0 To UBound(s)
     ww = Len(s(i))
        If ww + Len(tt) < w Then
            tt = tt & s(i) & " "
        Else
            a = a & tt & vbTab
                    If ww > w Then
                        For j = 0 To Int(ww / w)
                            If j = Int(ww / w) Then
                                tt = Mid(s(i), (j * w) + 1, w) & " "
                            Else
                                a = a & Mid(s(i), (j * w) + 1, w) & vbTab
                            End If
                        Next
                    Else
            tt = s(i) & " "
            End If
        End If
    Next
a = Split(a & tt, vbTab)
SplitCell.Resize(UBound(a)).Offset(1).Insert Shift:=xlDown
SplitCell.Resize(UBound(a) + 1).Value = Application.Transpose(a)
End Sub

...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Подскажите как разбить текс по ширене столбца / 12 сообщений из 12, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]