Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Разбивка ячеек по строкам с сохранением ширины столб (кросс) - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 212»
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Разбивка ячеек по строкам с сохранением ширины столб (кросс) (Макросы/Sub)
Разбивка ячеек по строкам с сохранением ширины столб (кросс)
dyhes Дата: Среда, 06.04.2016, 15:44 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Уважаемые форумчане! На дружеском сайте решение по проблеме не найдено, поэтому дублирую здесь ссылку на тему. Если кто сможет найти решение по данной проблеме буду благодарен.
http://www.planetaexcel.ru/forum....shirine

Проблема в следующем: при использовании макроса [vba]
Код
Sub WrapDown()
Dim c As Range, myRa As Range
Dim s As String
Dim arr As Variant
Dim i As Integer
Dim d As Variant
Application.ScreenUpdating = False

Set myRa = Selection
myC = myRa.Column
myE = myRa.Row - 1
myR = myRa.Row
myEC = myC + 1
Columns(myEC).EntireColumn.Clear
For Each r In myRa.Rows
myE = myE + 1
d = Cells(r.Row, myC).ColumnWidth * 1.05 'ширина первоначальной ячейки (несколько увеличена)
arr = Split(Cells(r.Row, myC), " ")
s = ""
For i = 0 To UBound(arr)
s = s & arr(i) & " "

Cells(myE, myEC) = s

Cells(myE, myEC).EntireColumn.AutoFit

If Cells(myE, myEC).ColumnWidth > d Then
Cells(myE, myEC).ColumnWidth = d
Cells(myE, myEC).Value = Left(s, Len(s) - (Len(arr(i)) + 1)) 'без последнего слова
i = i - 1 'т.к. слово выкинули

'---- переход в другую ячейку ----
myE = myE + 1
s = ""
End If
Next i
Next
myRa.Delete Shift:=xlUp
Range(Cells(myR, myEC), Cells(myE, myEC)).Copy
Cells(myR, myC).Insert Shift:=xlDown
Columns(myEC).EntireColumn.Clear
Application.ScreenUpdating = True
End Sub
[/vba]
ячейки разбиваются только для отдельного столбца, поэтому если в соседних столбцах есть какие-либо заполненные ячейки, они остаются на том же самом месте и целостность таблицы нарушается. Нужно оптимизировать этот код так, чтобы строки переносились целиком, а не только для отдельного столбца. Или найти какой-то другой способ решения данной проблемы.
[moder]Коды надо оформлять спецтегами (кнопка #), а не прятать под спойлер[/moder]
К сообщению приложен файл: ___-5-.xlsx(16Kb)


Сообщение отредактировал Pelena - Среда, 06.04.2016, 18:40
 
Ответить
СообщениеУважаемые форумчане! На дружеском сайте решение по проблеме не найдено, поэтому дублирую здесь ссылку на тему. Если кто сможет найти решение по данной проблеме буду благодарен.
http://www.planetaexcel.ru/forum....shirine

Проблема в следующем: при использовании макроса [vba]
Код
Sub WrapDown()
Dim c As Range, myRa As Range
Dim s As String
Dim arr As Variant
Dim i As Integer
Dim d As Variant
Application.ScreenUpdating = False

Set myRa = Selection
myC = myRa.Column
myE = myRa.Row - 1
myR = myRa.Row
myEC = myC + 1
Columns(myEC).EntireColumn.Clear
For Each r In myRa.Rows
myE = myE + 1
d = Cells(r.Row, myC).ColumnWidth * 1.05 'ширина первоначальной ячейки (несколько увеличена)
arr = Split(Cells(r.Row, myC), " ")
s = ""
For i = 0 To UBound(arr)
s = s & arr(i) & " "

Cells(myE, myEC) = s

Cells(myE, myEC).EntireColumn.AutoFit

If Cells(myE, myEC).ColumnWidth > d Then
Cells(myE, myEC).ColumnWidth = d
Cells(myE, myEC).Value = Left(s, Len(s) - (Len(arr(i)) + 1)) 'без последнего слова
i = i - 1 'т.к. слово выкинули

'---- переход в другую ячейку ----
myE = myE + 1
s = ""
End If
Next i
Next
myRa.Delete Shift:=xlUp
Range(Cells(myR, myEC), Cells(myE, myEC)).Copy
Cells(myR, myC).Insert Shift:=xlDown
Columns(myEC).EntireColumn.Clear
Application.ScreenUpdating = True
End Sub
[/vba]
ячейки разбиваются только для отдельного столбца, поэтому если в соседних столбцах есть какие-либо заполненные ячейки, они остаются на том же самом месте и целостность таблицы нарушается. Нужно оптимизировать этот код так, чтобы строки переносились целиком, а не только для отдельного столбца. Или найти какой-то другой способ решения данной проблемы.
[moder]Коды надо оформлять спецтегами (кнопка #), а не прятать под спойлер[/moder]

Автор - dyhes
Дата добавления - 06.04.2016 в 15:44
dima_dan2012 Дата: Среда, 06.04.2016, 16:22 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 7 ±
Замечаний: 0% ±

Excel 2003,2007
Здравствуйте!Схожую проблему недавно решали тыц http://www.excelworld.ru/forum/2-22545-1
Там переносили по 55 символов, но думаю разберётесь как переносить на сколько надо.


Сообщение отредактировал dima_dan2012 - Среда, 06.04.2016, 16:24
 
Ответить
СообщениеЗдравствуйте!Схожую проблему недавно решали тыц http://www.excelworld.ru/forum/2-22545-1
Там переносили по 55 символов, но думаю разберётесь как переносить на сколько надо.

Автор - dima_dan2012
Дата добавления - 06.04.2016 в 16:22
dyhes Дата: Среда, 06.04.2016, 17:52 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
dima_dan2012, спасибо, но вариант с определенным количеством символов не подходит. Хотелось бы допились существующий код, где уже переноситься по ширине ячейки
 
Ответить
Сообщениеdima_dan2012, спасибо, но вариант с определенным количеством символов не подходит. Хотелось бы допились существующий код, где уже переноситься по ширине ячейки

Автор - dyhes
Дата добавления - 06.04.2016 в 17:52
dima_dan2012 Дата: Среда, 06.04.2016, 23:27 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 7 ±
Замечаний: 0% ±

Excel 2003,2007
Попробуйте такой вариант - меняете ширину в итоговой таблице(страница 2) под неё будет подстраиваться перенос .Ячейки должны отформатированы без переноса по словам.
[vba]
Код

Sub WrapDown_full()
Dim c As Range, myRa As Range
Dim s As String
Dim arr As Variant
Dim arr1 As Variant
Dim i As Integer
Dim d As Variant
Application.ScreenUpdating = False
iRow = Sheets(1).Columns("A").CurrentRegion.Rows.Count
iCol = Sheets(1).Rows(1).CurrentRegion.Columns.Count
yGlobal = 2
yMem = 2
Set this_1 = ThisWorkbook.Sheets(1)
Set this_2 = ThisWorkbook.Sheets(2)
Set MEM = ThisWorkbook.Sheets(2).Cells(1, 655)
    this_2.[A1].CurrentRegion.Offset(1).ClearContents
ReDim arr1(iCol - 1) 'ìàññèâ øèðèí ñòîëáöîâ
For i = 0 To UBound(arr1)
arr1(i) = this_2.Cells(1, i + 1).ColumnWidth
Next i
For x = 2 To iRow
yLocal = yGlobal
    For Z = 1 To iCol '    .Range("c" & y).Value = r.Offset(, 1)
yLocal = yGlobal
arr = Split(this_1.Cells(x, Z), " ")
s = ""
For i = 0 To UBound(arr)
s = s & arr(i) & " "
    this_2.Cells(1, 655) = s
    this_2.Cells(1, 655).EntireColumn.AutoFit
'On Error GoTo ad:
If this_2.Cells(1, 655).ColumnWidth > arr1(Z - 1) Then
      If Len(s) <> Len(arr(i)) + 1 Then
      this_2.Cells(1, 655) = Left(s, Len(s) - Len(arr(i)) - 1) 'áåç ïîñëåäíåãî ñëîâà
         this_2.Cells(yLocal, Z) = this_2.Cells(1, 655)
        
            s = ""
            yLocal = yLocal + 1
            i = i - 1
        Else
        arr1(Z - 1) = this_2.Cells(1, 655).ColumnWidth
        this_2.Cells(yLocal, Z) = Left(s, Len(this_2.Cells(1, 655)) - 1)
        s = ""
        yLocal = yLocal + 1
    End If
End If
If this_2.Cells(1, 655).ColumnWidth < arr1(Z - 1) And i = UBound(arr) Then
        this_2.Cells(yLocal, Z) = this_2.Cells(1, 655)
yLocal = yLocal + 1
Exit For
ElseIf this_2.Cells(1, 655).ColumnWidth > arr1(Z - 1) And i = UBound(arr) Then
    arr1(Z - 1) = this_2.Cells(1, 655).ColumnWidth
    this_2.Cells(yLocal, Z) = this_2.Cells(1, 655)
yLocal = yLocal + 1
Exit For
End If
ad:
Next i
If yLocal > yMem Then
yMem = yLocal
End If
Next Z
yGlobal = yMem
Next x
Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: -5-my-my_new.xlsm(33Kb)


Сообщение отредактировал dima_dan2012 - Четверг, 07.04.2016, 09:17
 
Ответить
СообщениеПопробуйте такой вариант - меняете ширину в итоговой таблице(страница 2) под неё будет подстраиваться перенос .Ячейки должны отформатированы без переноса по словам.
[vba]
Код

Sub WrapDown_full()
Dim c As Range, myRa As Range
Dim s As String
Dim arr As Variant
Dim arr1 As Variant
Dim i As Integer
Dim d As Variant
Application.ScreenUpdating = False
iRow = Sheets(1).Columns("A").CurrentRegion.Rows.Count
iCol = Sheets(1).Rows(1).CurrentRegion.Columns.Count
yGlobal = 2
yMem = 2
Set this_1 = ThisWorkbook.Sheets(1)
Set this_2 = ThisWorkbook.Sheets(2)
Set MEM = ThisWorkbook.Sheets(2).Cells(1, 655)
    this_2.[A1].CurrentRegion.Offset(1).ClearContents
ReDim arr1(iCol - 1) 'ìàññèâ øèðèí ñòîëáöîâ
For i = 0 To UBound(arr1)
arr1(i) = this_2.Cells(1, i + 1).ColumnWidth
Next i
For x = 2 To iRow
yLocal = yGlobal
    For Z = 1 To iCol '    .Range("c" & y).Value = r.Offset(, 1)
yLocal = yGlobal
arr = Split(this_1.Cells(x, Z), " ")
s = ""
For i = 0 To UBound(arr)
s = s & arr(i) & " "
    this_2.Cells(1, 655) = s
    this_2.Cells(1, 655).EntireColumn.AutoFit
'On Error GoTo ad:
If this_2.Cells(1, 655).ColumnWidth > arr1(Z - 1) Then
      If Len(s) <> Len(arr(i)) + 1 Then
      this_2.Cells(1, 655) = Left(s, Len(s) - Len(arr(i)) - 1) 'áåç ïîñëåäíåãî ñëîâà
         this_2.Cells(yLocal, Z) = this_2.Cells(1, 655)
        
            s = ""
            yLocal = yLocal + 1
            i = i - 1
        Else
        arr1(Z - 1) = this_2.Cells(1, 655).ColumnWidth
        this_2.Cells(yLocal, Z) = Left(s, Len(this_2.Cells(1, 655)) - 1)
        s = ""
        yLocal = yLocal + 1
    End If
End If
If this_2.Cells(1, 655).ColumnWidth < arr1(Z - 1) And i = UBound(arr) Then
        this_2.Cells(yLocal, Z) = this_2.Cells(1, 655)
yLocal = yLocal + 1
Exit For
ElseIf this_2.Cells(1, 655).ColumnWidth > arr1(Z - 1) And i = UBound(arr) Then
    arr1(Z - 1) = this_2.Cells(1, 655).ColumnWidth
    this_2.Cells(yLocal, Z) = this_2.Cells(1, 655)
yLocal = yLocal + 1
Exit For
End If
ad:
Next i
If yLocal > yMem Then
yMem = yLocal
End If
Next Z
yGlobal = yMem
Next x
Application.ScreenUpdating = True
End Sub
[/vba]

Автор - dima_dan2012
Дата добавления - 06.04.2016 в 23:27
dyhes Дата: Четверг, 07.04.2016, 09:56 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
dima_dan2012, уже лучше, еще раз спасибо, но нужно чтобы разбивка происходила на этом же листе, заменяя их, а не на другом...
 
Ответить
Сообщениеdima_dan2012, уже лучше, еще раз спасибо, но нужно чтобы разбивка происходила на этом же листе, заменяя их, а не на другом...

Автор - dyhes
Дата добавления - 07.04.2016 в 09:56
nilem Дата: Четверг, 07.04.2016, 11:35 | Сообщение № 6
Группа: Авторы
Ранг: Старожил
Сообщений: 1284
Репутация: 463 ±
Замечаний: 0% ±

Excel 2013
dyhes, привет
попробуйте так:
[vba]
Код
Sub ertert()
Dim x, i&
With Range("A1:C" & Cells(Rows.Count, 1).End(xlUp).Row)
    x = .Value: .Offset(1).ClearContents
End With
Application.DisplayAlerts = False
For i = 2 To UBound(x)
    With Cells(Rows.Count, 2).End(xlUp)(2, 1)
        .Offset(, -1).Resize(, UBound(x, 2)).Value = Array(x(i, 1), x(i, 2), x(i, 3))
        .Justify
    End With
Next i
Application.DisplayAlerts = True
End Sub
[/vba]
Только предварительно умную таблицу нужно будет преобразовать в обычный диапазон


Яндекс.Деньги 4100159601573
 
Ответить
Сообщениеdyhes, привет
попробуйте так:
[vba]
Код
Sub ertert()
Dim x, i&
With Range("A1:C" & Cells(Rows.Count, 1).End(xlUp).Row)
    x = .Value: .Offset(1).ClearContents
End With
Application.DisplayAlerts = False
For i = 2 To UBound(x)
    With Cells(Rows.Count, 2).End(xlUp)(2, 1)
        .Offset(, -1).Resize(, UBound(x, 2)).Value = Array(x(i, 1), x(i, 2), x(i, 3))
        .Justify
    End With
Next i
Application.DisplayAlerts = True
End Sub
[/vba]
Только предварительно умную таблицу нужно будет преобразовать в обычный диапазон

Автор - nilem
Дата добавления - 07.04.2016 в 11:35
Jack_Famous_007 Дата: Четверг, 07.04.2016, 11:38 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Здравствуйте уважаемые форумчане! Я - автор данной темы на Планете))[moder] Подождите, а это dyhes тогда кто?[/moder] Не фанат кроссов, но на планете пока глухо, а решение очень необходимо в работе.
Решение от dima_dan2012, на данный момент больше всего подходит под решение проблемы. Небольшие проблемы связаны с тем, что работа данного макроса подразумевает использование шаблона (можно, конечно и без него, но для этого нужно держать в голове, что существует привязка ко ВТОРОМУ листу книги, а там могут быть данные и ВТОРЫМ листом может быть тот, с которого запускается макрос), а в шаблон необходимо перед запуском макроса перенести форматирование активного листа (интересуют только ширины столбцов).
Интересное дело: если на ВТОРОМ листе книги (на котором будет находится результат переноса) находится "умная" таблица целиком, то макрос, по сути, создаст в ней аналог исходника, безо всякого переноса по строкам)))
Никак не могу понять (оно и понятно, т.к. я в VBA полный пень), почему просто не переносить строки целиком в выделенном диапазоне, как в данном макросе (переносит вниз по разделителю "перенос строки"

[vba]
Код
Sub TOCInRange_vbNewLine()

'Ограниченная версия макроса с заданным разделителем "перенос строки"
'Автор: webley
'Редактор: JayBhagavan
'Сайт: http://planetaexcel.ru

Dim cl As Range, rng As Range, rngTmp As Range
Dim strDelim$, strTmp$
Dim arr() As String
Dim i&, n&, j&, k&

strDelim = Chr(10)
     
    If TypeName(Selection) = "Range" Then
        Set rng = Selection
        n = rng.Rows.Count
        For i = n To 1 Step -1
            With rng(i, 1)
                strTmp = .Value & strDelim
                arr = Split(strTmp, strDelim)
                j = UBound(arr, 1) - 1
                If j > 0 Then
                    .Offset(1).Resize(j).EntireRow.Insert Shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
                    Set rngTmp = .Resize(j + 1)
                    For k = 0 To j
                        rngTmp(k + 1, 1).Value = arr(k)
                    Next k
                End If
            End With
        Next i
    End If
End Sub

[/vba]


Сообщение отредактировал Pelena - Четверг, 07.04.2016, 11:43
 
Ответить
СообщениеЗдравствуйте уважаемые форумчане! Я - автор данной темы на Планете))[moder] Подождите, а это dyhes тогда кто?[/moder] Не фанат кроссов, но на планете пока глухо, а решение очень необходимо в работе.
Решение от dima_dan2012, на данный момент больше всего подходит под решение проблемы. Небольшие проблемы связаны с тем, что работа данного макроса подразумевает использование шаблона (можно, конечно и без него, но для этого нужно держать в голове, что существует привязка ко ВТОРОМУ листу книги, а там могут быть данные и ВТОРЫМ листом может быть тот, с которого запускается макрос), а в шаблон необходимо перед запуском макроса перенести форматирование активного листа (интересуют только ширины столбцов).
Интересное дело: если на ВТОРОМ листе книги (на котором будет находится результат переноса) находится "умная" таблица целиком, то макрос, по сути, создаст в ней аналог исходника, безо всякого переноса по строкам)))
Никак не могу понять (оно и понятно, т.к. я в VBA полный пень), почему просто не переносить строки целиком в выделенном диапазоне, как в данном макросе (переносит вниз по разделителю "перенос строки"

[vba]
Код
Sub TOCInRange_vbNewLine()

'Ограниченная версия макроса с заданным разделителем "перенос строки"
'Автор: webley
'Редактор: JayBhagavan
'Сайт: http://planetaexcel.ru

Dim cl As Range, rng As Range, rngTmp As Range
Dim strDelim$, strTmp$
Dim arr() As String
Dim i&, n&, j&, k&

strDelim = Chr(10)
     
    If TypeName(Selection) = "Range" Then
        Set rng = Selection
        n = rng.Rows.Count
        For i = n To 1 Step -1
            With rng(i, 1)
                strTmp = .Value & strDelim
                arr = Split(strTmp, strDelim)
                j = UBound(arr, 1) - 1
                If j > 0 Then
                    .Offset(1).Resize(j).EntireRow.Insert Shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
                    Set rngTmp = .Resize(j + 1)
                    For k = 0 To j
                        rngTmp(k + 1, 1).Value = arr(k)
                    Next k
                End If
            End With
        Next i
    End If
End Sub

[/vba]

Автор - Jack_Famous_007
Дата добавления - 07.04.2016 в 11:38
Jack_Famous_007 Дата: Четверг, 07.04.2016, 11:45 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
nilem, очень близко hands yes ))) только макрос по-прежнему привязан...на этот раз к конкретным столбцам. И зачем-то вставляет пустые строки сверху))) Можно ли, чтобы он работал в ВЫДЕЛЕННОМ ДИАПАЗОНЕ?
 
Ответить
Сообщениеnilem, очень близко hands yes ))) только макрос по-прежнему привязан...на этот раз к конкретным столбцам. И зачем-то вставляет пустые строки сверху))) Можно ли, чтобы он работал в ВЫДЕЛЕННОМ ДИАПАЗОНЕ?

Автор - Jack_Famous_007
Дата добавления - 07.04.2016 в 11:45
Jack_Famous_007 Дата: Четверг, 07.04.2016, 11:48 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Ответ модератору: dyhes - коллега по работе))) я заинтересован в этом макросе для коллекции) Среди прочих найденных решении этого вопроса данный вариант будет самым универсальным и подходящим для максимального количества задач
[moder]И вы работаете с одного компьютера? что-то слабо верится.


Сообщение отредактировал _Boroda_ - Четверг, 07.04.2016, 11:51
 
Ответить
СообщениеОтвет модератору: dyhes - коллега по работе))) я заинтересован в этом макросе для коллекции) Среди прочих найденных решении этого вопроса данный вариант будет самым универсальным и подходящим для максимального количества задач
[moder]И вы работаете с одного компьютера? что-то слабо верится.

Автор - Jack_Famous_007
Дата добавления - 07.04.2016 в 11:48
Jack_Famous_007 Дата: Четверг, 07.04.2016, 12:11 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
да нет...не с одного)) с чего вы взяли? Просто макрос нужен обоим. Мной когда-то был найден вариант этого макроса, который подошёл для выполнения конкретной задачи. Ему СЕЙЧАС нужен для немного других условий. А зачем плодить СПЕЦИФИЧЕСКИЕ макросы, если может быть ОДИН УНИВЕРСАЛЬНЫЙ?... Мне бы тоже было куда удобнее работать прямо в выделенном диапазоне без доп. листов, столбцов и т.д. а уже дальнейшие действия - кому-как надо...хочешь, копируй, хочешь переноси...
[moder]С того, что у вас IP одинаковый.


Сообщение отредактировал _Boroda_ - Четверг, 07.04.2016, 12:15
 
Ответить
Сообщениеда нет...не с одного)) с чего вы взяли? Просто макрос нужен обоим. Мной когда-то был найден вариант этого макроса, который подошёл для выполнения конкретной задачи. Ему СЕЙЧАС нужен для немного других условий. А зачем плодить СПЕЦИФИЧЕСКИЕ макросы, если может быть ОДИН УНИВЕРСАЛЬНЫЙ?... Мне бы тоже было куда удобнее работать прямо в выделенном диапазоне без доп. листов, столбцов и т.д. а уже дальнейшие действия - кому-как надо...хочешь, копируй, хочешь переноси...
[moder]С того, что у вас IP одинаковый.

Автор - Jack_Famous_007
Дата добавления - 07.04.2016 в 12:11
Jack_Famous_007 Дата: Четверг, 07.04.2016, 12:18 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
ну ХЗ...из-за общего роутера такое бывает?)) или вы думаете, что мы как в 90х у друга с Денди дома собрались и ждём своей очереди? ))))
[moder]Шутить я тоже умею. Вам продемонстрировать?


Сообщение отредактировал Jack_Famous_007 - Четверг, 07.04.2016, 12:29
 
Ответить
Сообщениену ХЗ...из-за общего роутера такое бывает?)) или вы думаете, что мы как в 90х у друга с Денди дома собрались и ждём своей очереди? ))))
[moder]Шутить я тоже умею. Вам продемонстрировать?

Автор - Jack_Famous_007
Дата добавления - 07.04.2016 в 12:18
dima_dan2012 Дата: Четверг, 07.04.2016, 12:22 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 7 ±
Замечаний: 0% ±

Excel 2003,2007
Не знаю -может где-то ошибок напорол -мы учимся;)


Сообщение отредактировал dima_dan2012 - Пятница, 08.04.2016, 10:43
 
Ответить
СообщениеНе знаю -может где-то ошибок напорол -мы учимся;)

Автор - dima_dan2012
Дата добавления - 07.04.2016 в 12:22
Jack_Famous_007 Дата: Четверг, 07.04.2016, 12:30 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Модератору: угрожать своими "шутками" - не стоит - у модераторов они, как правило, являются банами (так себе шутка, на мой взгляд) В любом случае, шутка была НЕ над вами и НЕ про вас. конфликтовать с администрацией сайта мне меньше всего улыбается. Вы спросили - я ответил.
 
Ответить
СообщениеМодератору: угрожать своими "шутками" - не стоит - у модераторов они, как правило, являются банами (так себе шутка, на мой взгляд) В любом случае, шутка была НЕ над вами и НЕ про вас. конфликтовать с администрацией сайта мне меньше всего улыбается. Вы спросили - я ответил.

Автор - Jack_Famous_007
Дата добавления - 07.04.2016 в 12:30
dyhes Дата: Четверг, 07.04.2016, 13:14 | Сообщение № 14
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
dima_dan2012, не работает на текущем листе. Нужно сделать так, чтобы макрос работал на одном активном листе , не привязывался к названию листа и не зависел от других, в том числе не создавал временные листы и пр.
 
Ответить
Сообщениеdima_dan2012, не работает на текущем листе. Нужно сделать так, чтобы макрос работал на одном активном листе , не привязывался к названию листа и не зависел от других, в том числе не создавал временные листы и пр.

Автор - dyhes
Дата добавления - 07.04.2016 в 13:14
Jack_Famous_007 Дата: Четверг, 07.04.2016, 13:23 | Сообщение № 15
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Ребят, ещё раз опишу мысль. В посте №7 есть рабочий макрос, который разделяет текст по заданному критерию (в данном случае "перенос строки") каждой ячейки в выделенном диапазоне вниз со сдвигом строк целиком. И ему не важно, сколько столбцов слева или справа заполнено, т.к. значения в них сдвигаются вместе с ним (сдвига строк целиком). Я не знаю, каким именно образом в ваших макросах определяется, когда переносить в следующую строку при заполнении по ширине, но если этот признак/критерий/условие передать в макрос поста №7 и он сможет переносить по нему, то это будет то, что нужно :)
 
Ответить
СообщениеРебят, ещё раз опишу мысль. В посте №7 есть рабочий макрос, который разделяет текст по заданному критерию (в данном случае "перенос строки") каждой ячейки в выделенном диапазоне вниз со сдвигом строк целиком. И ему не важно, сколько столбцов слева или справа заполнено, т.к. значения в них сдвигаются вместе с ним (сдвига строк целиком). Я не знаю, каким именно образом в ваших макросах определяется, когда переносить в следующую строку при заполнении по ширине, но если этот признак/критерий/условие передать в макрос поста №7 и он сможет переносить по нему, то это будет то, что нужно :)

Автор - Jack_Famous_007
Дата добавления - 07.04.2016 в 13:23
dima_dan2012 Дата: Четверг, 07.04.2016, 13:40 | Сообщение № 16
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 7 ±
Замечаний: 0% ±

Excel 2003,2007
dyhes У меня запускается ;)
Надо только поменять ThisWorkbook.Sheets(1) на ActiveSheet и всё заработает на любом листе.

 
Ответить
Сообщениеdyhes У меня запускается ;)
Надо только поменять ThisWorkbook.Sheets(1) на ActiveSheet и всё заработает на любом листе.


Автор - dima_dan2012
Дата добавления - 07.04.2016 в 13:40
Jack_Famous_007 Дата: Четверг, 07.04.2016, 13:45 | Сообщение № 17
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Этот вариант переносит как надо, но работает только с 1 ячейкой (активной) ((( Ну и требует задать ширину, что не критично... Можно ли как-то изменить его для цикла по ячейкам в выделенном диапазоне?...
p.S.: НЕ про вариант dima_dan2012
[moder] Jack_Famous_007, не захламляйте тему. Есть автор, есть предложение решения его вопроса. Вы, как сами утверждаете, не являетесь автором темы, поэтому не надо задавать свои вопросы в чужой теме (Правила форума)[/moder]
К сообщению приложен файл: TexttoRows.xls(48Kb)


Сообщение отредактировал Pelena - Четверг, 07.04.2016, 14:05
 
Ответить
СообщениеЭтот вариант переносит как надо, но работает только с 1 ячейкой (активной) ((( Ну и требует задать ширину, что не критично... Можно ли как-то изменить его для цикла по ячейкам в выделенном диапазоне?...
p.S.: НЕ про вариант dima_dan2012
[moder] Jack_Famous_007, не захламляйте тему. Есть автор, есть предложение решения его вопроса. Вы, как сами утверждаете, не являетесь автором темы, поэтому не надо задавать свои вопросы в чужой теме (Правила форума)[/moder]

Автор - Jack_Famous_007
Дата добавления - 07.04.2016 в 13:45
dyhes Дата: Четверг, 07.04.2016, 14:02 | Сообщение № 18
Группа: Пользователи
Ранг: Новичок
Сообщений: 28
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
dima_dan2012, данный код привязан к данной текущей таблице. Если , например, в таблице добавить столбцы, то макрос начинает работать некорректно. Может быть, все же, найдется такое решение, чтобы ячейки разбивались в независимости от относительного их расположения. В идеале - выделил диапазон - и каждая объеденная ячейка, входящая в этот диапазон разбивалась построчно с сохранением ширины ячейки...

Модератор, пускай человек задает вопросы, чем он мешает - то если все по теме?


Сообщение отредактировал dyhes - Четверг, 07.04.2016, 14:45
 
Ответить
Сообщениеdima_dan2012, данный код привязан к данной текущей таблице. Если , например, в таблице добавить столбцы, то макрос начинает работать некорректно. Может быть, все же, найдется такое решение, чтобы ячейки разбивались в независимости от относительного их расположения. В идеале - выделил диапазон - и каждая объеденная ячейка, входящая в этот диапазон разбивалась построчно с сохранением ширины ячейки...

Модератор, пускай человек задает вопросы, чем он мешает - то если все по теме?

Автор - dyhes
Дата добавления - 07.04.2016 в 14:02
Jack_Famous_007 Дата: Четверг, 07.04.2016, 14:14 | Сообщение № 19
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Модератору: мы же с автором темы заодно... Нам (а в случае решения проблемы и многим другим) нужно одно и то же, просто, пока он тестит, я пробую варианты и ищу в интернете (и наоборот).
[moder]Замечание Вам за нарушение Правил форума[/moder]
 
Ответить
СообщениеМодератору: мы же с автором темы заодно... Нам (а в случае решения проблемы и многим другим) нужно одно и то же, просто, пока он тестит, я пробую варианты и ищу в интернете (и наоборот).
[moder]Замечание Вам за нарушение Правил форума[/moder]

Автор - Jack_Famous_007
Дата добавления - 07.04.2016 в 14:14
dima_dan2012 Дата: Четверг, 07.04.2016, 14:41 | Сообщение № 20
Группа: Пользователи
Ранг: Новичок
Сообщений: 36
Репутация: 7 ±
Замечаний: 0% ±

Excel 2003,2007
Добавлял столбцы - вроде работает но не очень корректно переносит. Надо тестить ,главное чтобы формат ячейки был без переноса строки.
Кстати а зачем такие мучения?
Разве стандартными средствами нельзя организовать нормальный перенос на следующую строку?


Сообщение отредактировал dima_dan2012 - Пятница, 08.04.2016, 10:43
 
Ответить
СообщениеДобавлял столбцы - вроде работает но не очень корректно переносит. Надо тестить ,главное чтобы формат ячейки был без переноса строки.
Кстати а зачем такие мучения?
Разве стандартными средствами нельзя организовать нормальный перенос на следующую строку?

Автор - dima_dan2012
Дата добавления - 07.04.2016 в 14:41
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Разбивка ячеек по строкам с сохранением ширины столб (кросс) (Макросы/Sub)
Страница 1 из 212»
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!