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

Вход

Регистрация

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

 

= Мир MS Excel/Вставка строк с последующим их заполнение - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставка строк с последующим их заполнение (Макросы Sub)
Вставка строк с последующим их заполнение
Lubasha Дата: Среда, 30.10.2013, 08:52 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Здравствуйте.
Есть таблица, начиная с 36 столбца идет разбиение суммы, которая находится в столбце 14 в соответствующей строке, необходимо к каждой строке добавить количество строк, которое соответствует количеству ненулевых значений в правой части строки (начиная с 36 ячейки) - с этой задачей я справилась (не идеально, конечно). Теперь необходимо заполнить добавленные строки, а именно в столбце 14 прописать значения строки,к которой были добавлены строки, начиная с 36 ячейки в этой строке, остальные ячейки остаются такими же как и в исходной строке. Пробовала заполнять циклом-не получается. В идеале необходимо еще и удалить исходную строку.
Мои идеи иссякли, прошу Вас помочь.
К сообщению приложен файл: 3730463.xlsx (98.8 Kb)
 
Ответить
СообщениеЗдравствуйте.
Есть таблица, начиная с 36 столбца идет разбиение суммы, которая находится в столбце 14 в соответствующей строке, необходимо к каждой строке добавить количество строк, которое соответствует количеству ненулевых значений в правой части строки (начиная с 36 ячейки) - с этой задачей я справилась (не идеально, конечно). Теперь необходимо заполнить добавленные строки, а именно в столбце 14 прописать значения строки,к которой были добавлены строки, начиная с 36 ячейки в этой строке, остальные ячейки остаются такими же как и в исходной строке. Пробовала заполнять циклом-не получается. В идеале необходимо еще и удалить исходную строку.
Мои идеи иссякли, прошу Вас помочь.
Автор - Lubasha
Дата добавления - 30.10.2013 в 08:52
Lubasha Дата: Среда, 30.10.2013, 15:14 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Возможно я не понятно поставила задачу, тогда хотелось бы увидеть вопросы...
 
Ответить
СообщениеВозможно я не понятно поставила задачу, тогда хотелось бы увидеть вопросы...
Автор - Lubasha
Дата добавления - 30.10.2013 в 15:14
Lubasha Дата: Среда, 30.10.2013, 15:22 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Или может быть подскажите как в столбец записать значения из строки?
 
Ответить
СообщениеИли может быть подскажите как в столбец записать значения из строки?
Автор - Lubasha
Дата добавления - 30.10.2013 в 15:22
Lubasha Дата: Четверг, 31.10.2013, 09:29 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
[vba]
Код
Option Explicit
Option Base 1

Sub Discret()

Dim lLastRow, lLastCol As Long
Dim SumAray(), StrArray() As Double

Dim Pr As String
Dim i, k, l As Long
Dim j As Long
Dim s As Integer

lLastRow = Cells(Rows.Count, 30).End(xlUp).Row ' определяем посл ячейку в столбце 30

Application.ScreenUpdating = False

For i = lLastRow To 295 Step -1

lLastCol = Cells(i, Columns.Count).End(xlToLeft).Column
s = 0

For j = lLastCol To 36 Step -1

If Cells(i, j).Value <> 0 Then
s = s + 1
Else
If Cells(i, j).Value = 0 Then
s = s
End If
End If

Next j

If s > 0 Then
Rows(i).Resize(s).Insert

End If

Next i
k = 0
lLastRow = Cells(Rows.Count, 36).End(xlUp).Row
MsgBox lLastRow, vbInformation
For i = lLastRow To 595 Step -1

lLastCol = Cells(i, Columns.Count).End(xlToLeft).Column

For j = lLastCol To 36 Step -1

If Cells(i, j).Value <> 0 Then
k = k + 1
Cells(i - k, 14).Value = Cells(i, j).Value

End If

Next j

i = i - k
k = 0

Next i

Application.ScreenUpdating = True

MsgBox "Конец!", vbInformation

End Sub
[/vba]

Прилагаю свое решение, поставленная задача в процессе решения, но теперь возникла новая проблема. Я считаю количество ненулевых ячек, а затем добавляю этакое количество строк, так вот если нулевые ячейки присутствуют, то добавляется строк на 1 меньше, причем просматривая выполнение программы по шагам, количество ненулевых считается верно, а вот добавляет меньше. Подскажите пож-та с чем это связано и как можно исправить...
 
Ответить
Сообщение[vba]
Код
Option Explicit
Option Base 1

Sub Discret()

Dim lLastRow, lLastCol As Long
Dim SumAray(), StrArray() As Double

Dim Pr As String
Dim i, k, l As Long
Dim j As Long
Dim s As Integer

lLastRow = Cells(Rows.Count, 30).End(xlUp).Row ' определяем посл ячейку в столбце 30

Application.ScreenUpdating = False

For i = lLastRow To 295 Step -1

lLastCol = Cells(i, Columns.Count).End(xlToLeft).Column
s = 0

For j = lLastCol To 36 Step -1

If Cells(i, j).Value <> 0 Then
s = s + 1
Else
If Cells(i, j).Value = 0 Then
s = s
End If
End If

Next j

If s > 0 Then
Rows(i).Resize(s).Insert

End If

Next i
k = 0
lLastRow = Cells(Rows.Count, 36).End(xlUp).Row
MsgBox lLastRow, vbInformation
For i = lLastRow To 595 Step -1

lLastCol = Cells(i, Columns.Count).End(xlToLeft).Column

For j = lLastCol To 36 Step -1

If Cells(i, j).Value <> 0 Then
k = k + 1
Cells(i - k, 14).Value = Cells(i, j).Value

End If

Next j

i = i - k
k = 0

Next i

Application.ScreenUpdating = True

MsgBox "Конец!", vbInformation

End Sub
[/vba]

Прилагаю свое решение, поставленная задача в процессе решения, но теперь возникла новая проблема. Я считаю количество ненулевых ячек, а затем добавляю этакое количество строк, так вот если нулевые ячейки присутствуют, то добавляется строк на 1 меньше, причем просматривая выполнение программы по шагам, количество ненулевых считается верно, а вот добавляет меньше. Подскажите пож-та с чем это связано и как можно исправить...
Автор - Lubasha
Дата добавления - 31.10.2013 в 09:29
Wasilich Дата: Четверг, 31.10.2013, 11:46 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 1232
Репутация: 326 ±
Замечаний: 0% ±

2003
Lubasha, в своем примере, ручками вставьте после 9-той строки еще 3 строчки и так же ручками заполните их так, как надо заполнить макросом.
А то, действительно, ниччче не понятно.
 
Ответить
СообщениеLubasha, в своем примере, ручками вставьте после 9-той строки еще 3 строчки и так же ручками заполните их так, как надо заполнить макросом.
А то, действительно, ниччче не понятно.
Автор - Wasilich
Дата добавления - 31.10.2013 в 11:46
KuklP Дата: Четверг, 31.10.2013, 13:16 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Форумчане, киньте в Любашу ссылкой на индентер, пожалуйста. Если ни у кого под рукой нет - Люба, пишите в личку, отправлю Вам в почту.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеФорумчане, киньте в Любашу ссылкой на индентер, пожалуйста. Если ни у кого под рукой нет - Люба, пишите в личку, отправлю Вам в почту.
Автор - KuklP
Дата добавления - 31.10.2013 в 13:16
Lubasha Дата: Четверг, 31.10.2013, 13:55 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Wasilic, На самом деле это огромная таблица с данным, файл во вложении это всего лишь очень маленькая ее часть, в связи с чем и требуется написать макрос.
 
Ответить
СообщениеWasilic, На самом деле это огромная таблица с данным, файл во вложении это всего лишь очень маленькая ее часть, в связи с чем и требуется написать макрос.
Автор - Lubasha
Дата добавления - 31.10.2013 в 13:55
Lubasha Дата: Четверг, 31.10.2013, 14:23 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Wasilic, креплю файл.

Ниже мой макрос, он уже все заполняет, теперь нужно удалить строки, к которым добавляли

[vba]
Код
Option Explicit
Option Base 1

Sub Discret()

Dim lLastRow, lLastCol As Long
Dim SumAray(), StrArray() As Double

Dim Pr As String
Dim i, k, l As Long
Dim j As Long
Dim s, n As Integer

lLastRow = Cells(Rows.Count, 30).End(xlUp).Row ' определяем посл ячейку в столбце 30

Application.ScreenUpdating = False

' Считаем количество ненулевых ячеек в разбивке и добавляем такое количенство строк
For i = lLastRow To 295 Step -1

lLastCol = Cells(i, Columns.Count).End(xlToLeft).Column
s = 0

For j = lLastCol To 36 Step -1

If Cells(i, j).Value <> 0 Then
s = s + 1
Else
If Cells(i, j).Value = 0 Then
s = s
End If
End If

Next j

If s > 0 Then
Rows(i).Resize(s).Insert

End If

Next i

' Заполняем добавленные строки
k = 0
lLastRow = Cells(Rows.Count, 36).End(xlUp).Row

For i = lLastRow To 595 Step -1

lLastCol = Cells(i, Columns.Count).End(xlToLeft).Column

For j = lLastCol To 36 Step -1

If Cells(i, j).Value <> 0 Then
k = k + 1
Cells(i - k, 14).Value = Cells(i, j).Value
Cells(i - k, 33).Value = Cells(6, j).Value
Cells(i - k, 1).Value = Cells(i, 1).Value
Cells(i - k, 2).Value = Cells(i, 2).Value
Cells(i - k, 3).Value = Cells(i, 3).Value
Cells(i - k, 4).Value = Cells(i, 4).Value
Cells(i - k, 5).Value = Cells(i, 5).Value
Cells(i - k, 6).Value = Cells(i, 6).Value
Cells(i - k, 7).Value = Cells(i, 7).Value
Cells(i - k, 8).Value = Cells(i, 8).Value
Cells(i - k, 9).Value = Cells(i, 9).Value
Cells(i - k, 10).Value = Cells(i, 10).Value
Cells(i - k, 11).Value = Cells(i, 11).Value
Cells(i - k, 12).Value = Cells(i, 12).Value
Cells(i - k, 13).Value = Cells(i, 13).Value
Cells(i - k, 14).Value = Cells(i, 14).Value
Cells(i - k, 15).Value = Cells(i, 15).Value
Cells(i - k, 16).Value = Cells(i, 16).Value
Cells(i - k, 17).Value = Cells(i, 17).Value
Cells(i - k, 18).Value = Cells(i, 18).Value
Cells(i - k, 19).Value = Cells(i, 19).Value
Cells(i - k, 20).Value = Cells(i, 20).Value
Cells(i - k, 21).Value = Cells(i, 21).Value
Cells(i - k, 22).Value = Cells(i, 22).Value
Cells(i - k, 23).Value = Cells(i, 23).Value
Cells(i - k, 24).Value = Cells(i, 24).Value
Cells(i - k, 25).Value = Cells(i, 25).Value
Cells(i - k, 26).Value = Cells(i, 26).Value
Cells(i - k, 27).Value = Cells(i, 27).Value
Cells(i - k, 28).Value = Cells(i, 28).Value
Cells(i - k, 29).Value = Cells(i, 29).Value
Cells(i - k, 30).Value = Cells(i, 30).Value
Cells(i - k, 31).Value = Cells(i, 31).Value
Cells(i - k, 32).Value = Cells(i, 32).Value
Cells(i - k, 33).Value = Cells(i, 33).Value
Cells(i - k, 34).Value = Cells(i, 34).Value
Cells(i - k, 35).Value = Cells(i, 35).Value

End If

Next j

i = i - k
k = 0

Next i

Application.ScreenUpdating = True

MsgBox "Конец!", vbInformation

End Sub
[/vba]

Т. к. таблица оч большая, боюсь, что мое решение окажется не эффективным, может быть есть другие идеи
[moder]Оформляйте коды тегами. Кнопка #[/moder]
 
Ответить
СообщениеWasilic, креплю файл.

Ниже мой макрос, он уже все заполняет, теперь нужно удалить строки, к которым добавляли

[vba]
Код
Option Explicit
Option Base 1

Sub Discret()

Dim lLastRow, lLastCol As Long
Dim SumAray(), StrArray() As Double

Dim Pr As String
Dim i, k, l As Long
Dim j As Long
Dim s, n As Integer

lLastRow = Cells(Rows.Count, 30).End(xlUp).Row ' определяем посл ячейку в столбце 30

Application.ScreenUpdating = False

' Считаем количество ненулевых ячеек в разбивке и добавляем такое количенство строк
For i = lLastRow To 295 Step -1

lLastCol = Cells(i, Columns.Count).End(xlToLeft).Column
s = 0

For j = lLastCol To 36 Step -1

If Cells(i, j).Value <> 0 Then
s = s + 1
Else
If Cells(i, j).Value = 0 Then
s = s
End If
End If

Next j

If s > 0 Then
Rows(i).Resize(s).Insert

End If

Next i

' Заполняем добавленные строки
k = 0
lLastRow = Cells(Rows.Count, 36).End(xlUp).Row

For i = lLastRow To 595 Step -1

lLastCol = Cells(i, Columns.Count).End(xlToLeft).Column

For j = lLastCol To 36 Step -1

If Cells(i, j).Value <> 0 Then
k = k + 1
Cells(i - k, 14).Value = Cells(i, j).Value
Cells(i - k, 33).Value = Cells(6, j).Value
Cells(i - k, 1).Value = Cells(i, 1).Value
Cells(i - k, 2).Value = Cells(i, 2).Value
Cells(i - k, 3).Value = Cells(i, 3).Value
Cells(i - k, 4).Value = Cells(i, 4).Value
Cells(i - k, 5).Value = Cells(i, 5).Value
Cells(i - k, 6).Value = Cells(i, 6).Value
Cells(i - k, 7).Value = Cells(i, 7).Value
Cells(i - k, 8).Value = Cells(i, 8).Value
Cells(i - k, 9).Value = Cells(i, 9).Value
Cells(i - k, 10).Value = Cells(i, 10).Value
Cells(i - k, 11).Value = Cells(i, 11).Value
Cells(i - k, 12).Value = Cells(i, 12).Value
Cells(i - k, 13).Value = Cells(i, 13).Value
Cells(i - k, 14).Value = Cells(i, 14).Value
Cells(i - k, 15).Value = Cells(i, 15).Value
Cells(i - k, 16).Value = Cells(i, 16).Value
Cells(i - k, 17).Value = Cells(i, 17).Value
Cells(i - k, 18).Value = Cells(i, 18).Value
Cells(i - k, 19).Value = Cells(i, 19).Value
Cells(i - k, 20).Value = Cells(i, 20).Value
Cells(i - k, 21).Value = Cells(i, 21).Value
Cells(i - k, 22).Value = Cells(i, 22).Value
Cells(i - k, 23).Value = Cells(i, 23).Value
Cells(i - k, 24).Value = Cells(i, 24).Value
Cells(i - k, 25).Value = Cells(i, 25).Value
Cells(i - k, 26).Value = Cells(i, 26).Value
Cells(i - k, 27).Value = Cells(i, 27).Value
Cells(i - k, 28).Value = Cells(i, 28).Value
Cells(i - k, 29).Value = Cells(i, 29).Value
Cells(i - k, 30).Value = Cells(i, 30).Value
Cells(i - k, 31).Value = Cells(i, 31).Value
Cells(i - k, 32).Value = Cells(i, 32).Value
Cells(i - k, 33).Value = Cells(i, 33).Value
Cells(i - k, 34).Value = Cells(i, 34).Value
Cells(i - k, 35).Value = Cells(i, 35).Value

End If

Next j

i = i - k
k = 0

Next i

Application.ScreenUpdating = True

MsgBox "Конец!", vbInformation

End Sub
[/vba]

Т. к. таблица оч большая, боюсь, что мое решение окажется не эффективным, может быть есть другие идеи
[moder]Оформляйте коды тегами. Кнопка #[/moder]
Автор - Lubasha
Дата добавления - 31.10.2013 в 14:23
Wasilich Дата: Четверг, 31.10.2013, 23:30 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 1232
Репутация: 326 ±
Замечаний: 0% ±

2003
Цитата Lubasha, 31.10.2013 в 14:23, в сообщении № 9
Wasilic, креплю файл.
Куда? Я не вижу.
Я просил в пример из первого сообщения, в котором на 9-ой строке в диапазоне столбцов 36-42 есть 3 нуля, добавить ручками 3 строки и ручками заполнить их так, как это должен сделать макрос. И все. В Вашем макросе разбираться ... %)
Поэтому, в примере я сделал как понял.
К сообщению приложен файл: Lubasha.rar (50.8 Kb)
 
Ответить
Сообщение
Цитата Lubasha, 31.10.2013 в 14:23, в сообщении № 9
Wasilic, креплю файл.
Куда? Я не вижу.
Я просил в пример из первого сообщения, в котором на 9-ой строке в диапазоне столбцов 36-42 есть 3 нуля, добавить ручками 3 строки и ручками заполнить их так, как это должен сделать макрос. И все. В Вашем макросе разбираться ... %)
Поэтому, в примере я сделал как понял.
Автор - Wasilich
Дата добавления - 31.10.2013 в 23:30
Lubasha Дата: Пятница, 01.11.2013, 07:03 | Сообщение № 10
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Wasilic, не прикрепился файл....
Сейчас все сделала, как Вы просили
К сообщению приложен файл: Lubasha.7z (42.9 Kb)
 
Ответить
СообщениеWasilic, не прикрепился файл....
Сейчас все сделала, как Вы просили
Автор - Lubasha
Дата добавления - 01.11.2013 в 07:03
Wasilich Дата: Пятница, 01.11.2013, 15:15 | Сообщение № 11
Группа: Друзья
Ранг: Старожил
Сообщений: 1232
Репутация: 326 ±
Замечаний: 0% ±

2003
Сделал как сумел:
К сообщению приложен файл: Lubasha3.rar (50.1 Kb)
 
Ответить
СообщениеСделал как сумел:
Автор - Wasilich
Дата добавления - 01.11.2013 в 15:15
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставка строк с последующим их заполнение (Макросы Sub)
  • Страница 1 из 1
  • 1
Поиск:

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