Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Разделение данных строки на несколько строк
 
#1
19.11.2016 10:47:02
Подскажите пожалуйста, при помощи какой формулы или макроса можно разделить данные строки на несколько строк как в примере во вложении?

файл удален
 
 
 
#2
19.11.2016 10:50:34
При открытии файла появляется сообщение, что расширение файла не соответствует. Прикрепите другой файл.
 
 
 
#3
19.11.2016 10:52:05
Ваш файл не открывается, возможно из за названия, пишет что поврежден.
 
 
 
#4
19.11.2016 11:01:24
У файла нулевой размер
 
 
 
#5
19.11.2016 12:04:43
Файл заменен
 
 
 
#6
19.11.2016 12:40:39
Код
Option Explicit

Sub jjj_make_new_tab()
    Dim rngIn As Range, rngRow As Range
    Dim lCnt As Long, lRows As Long
    
    Set rngIn = Worksheets("Исходник").Range("A2:D5")
    
    lCnt = 0
    For Each rngRow In rngIn.Rows
        lRows = rngRow(1).Cells(1).Value
        With Worksheets("Хотелка").Range("A2:D2").Offset(lCnt)
            rngRow.Copy .Resize(lRows)
            .Resize(lRows, 1).Value = 1
        End With
        lCnt = lCnt + lRows
    Next rngRow
End Sub

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#7
19.11.2016 13:07:46
Спасибо, работает.
 
 
 
#8
20.11.2016 08:15:43
Подскажите пожалуйста, как в этом макросе заменить листы "Исходник" на текущий лист (тот на котором находишься, с любым названием) и "Хотелка" на новый лист?
 
 
 
#9
20.11.2016 08:46:48
Код
Option Explicit
  
Sub jjj_make_new_tab()
    Dim rngIn As Range, rngOut As Range, rngRow As Range
    Dim lCnt As Long, lRows As Long
      
    Set rngIn = ActiveSheet.Range("A2:D5")
    With ActiveWorkbook
        Set rngOut = .Sheets.Add(, .Sheets(.Sheets.Count), 1, xlWorksheet).Range("A1:D1")
    End With
    
    rngIn.Resize(1).Offset(-1).Copy rngOut
    lCnt = 1
    For Each rngRow In rngIn.Rows
        lRows = rngRow(1).Cells(1).Value
        With rngOut.Offset(lCnt)
            rngRow.Copy .Resize(lRows)
            .Resize(lRows, 1).Value = 1
            .Resize(lRows, 1).Offset(, 1).Value = rngRow(1).Cells(2).Value / lRows
            .Resize(lRows, 1).Offset(, 2).Value = rngRow(1).Cells(3).Value / lRows
        End With
        lCnt = lCnt + lRows
    Next rngRow
End Sub
Изменено: JayBhagavan - 20.11.2016 09:48:52

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#10
20.11.2016 09:09:38
Сразу не заметила, что макрос строки разделяет, а суммы нет. Суммы тоже разделяться должны, как в примере. Помогите, пожалуйста.
 
 
 
#11
20.11.2016 09:49:07
Исправил.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#12
20.11.2016 10:08:18
Спасибо большое. Все работает так как надо.
 
 
 
Страницы: 1
Наверх