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

Вход

Регистрация

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

 

= Мир MS Excel/Вставка пустых строк после 2 - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставка пустых строк после 2 (Макросы/Sub)
Вставка пустых строк после 2
ant6729 Дата: Воскресенье, 27.03.2016, 13:00 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Добрый день, нужен макрос, чтобы выполнял операцию в виде, как на лист2.
К сообщению приложен файл: 9045894.xlsx (9.4 Kb)
 
Ответить
СообщениеДобрый день, нужен макрос, чтобы выполнял операцию в виде, как на лист2.

Автор - ant6729
Дата добавления - 27.03.2016 в 13:00
KuklP Дата: Воскресенье, 27.03.2016, 13:13 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
И что? Какой вопрос Вас интересует? Я к тому, что это ветка "Вопросы по VBA". Стол заказов в ветке Работа.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеИ что? Какой вопрос Вас интересует? Я к тому, что это ветка "Вопросы по VBA". Стол заказов в ветке Работа.

Автор - KuklP
Дата добавления - 27.03.2016 в 13:13
dima_dan2012 Дата: Воскресенье, 27.03.2016, 13:33 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 38
Репутация: 8 ±
Замечаний: 0% ±

Excel 2003,2007
Как-то так надо только добавить 3 листик
[vba]
Код
Sub a()
Set ab = ThisWorkbook.Sheets(1).Range("a1:a" & ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
i = 1
y = 1
ThisWorkbook.Sheets(3).UsedRange.Clear
For Each aa In ab
    With ThisWorkbook.Sheets(3)
      .Range("a" & i).Value = aa
        .Range("b" & i).Value = ThisWorkbook.Sheets(1).Range("b" & y).Value
        .Range("c" & i).Value = ThisWorkbook.Sheets(1).Range("c" & y).Value
        .Range("d" & i).Value = ThisWorkbook.Sheets(1).Range("d" & y).Value
    End With

    If a.Value = 2 Then
        i = i + 2
    Else
        i = i + 1
    End If
y=y+1
Next aa
End Sub
[/vba]


WM :Z116994103939

Сообщение отредактировал dima_dan2012 - Воскресенье, 27.03.2016, 16:28
 
Ответить
СообщениеКак-то так надо только добавить 3 листик
[vba]
Код
Sub a()
Set ab = ThisWorkbook.Sheets(1).Range("a1:a" & ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
i = 1
y = 1
ThisWorkbook.Sheets(3).UsedRange.Clear
For Each aa In ab
    With ThisWorkbook.Sheets(3)
      .Range("a" & i).Value = aa
        .Range("b" & i).Value = ThisWorkbook.Sheets(1).Range("b" & y).Value
        .Range("c" & i).Value = ThisWorkbook.Sheets(1).Range("c" & y).Value
        .Range("d" & i).Value = ThisWorkbook.Sheets(1).Range("d" & y).Value
    End With

    If a.Value = 2 Then
        i = i + 2
    Else
        i = i + 1
    End If
y=y+1
Next aa
End Sub
[/vba]

Автор - dima_dan2012
Дата добавления - 27.03.2016 в 13:33
StoTisteg Дата: Воскресенье, 27.03.2016, 14:28 | Сообщение № 4
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
dima_dan2012, какой листик? зачем?
[vba]
Код
Sub test()

    Dim i As Integer
    
    i = 1
    Do While i < Cells(Rows.Count, 1).End(xlUp).Row
        If val(Cells(i, 1).Value) = 2 Then
            Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            i = i + 2
            Else: i = i + 1
        End If
    Loop

End Sub
[/vba]


Интуитивно понятный код - это когда интуитивно понятно, что это код.

Сообщение отредактировал StoTisteg - Воскресенье, 27.03.2016, 14:29
 
Ответить
Сообщениеdima_dan2012, какой листик? зачем?
[vba]
Код
Sub test()

    Dim i As Integer
    
    i = 1
    Do While i < Cells(Rows.Count, 1).End(xlUp).Row
        If val(Cells(i, 1).Value) = 2 Then
            Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            i = i + 2
            Else: i = i + 1
        End If
    Loop

End Sub
[/vba]

Автор - StoTisteg
Дата добавления - 27.03.2016 в 14:28
dima_dan2012 Дата: Воскресенье, 27.03.2016, 15:06 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 38
Репутация: 8 ±
Замечаний: 0% ±

Excel 2003,2007
StoTistegНу как-бы не хорошо портить данные . Запустите ваш макрос несколько раз .


WM :Z116994103939
 
Ответить
СообщениеStoTistegНу как-бы не хорошо портить данные . Запустите ваш макрос несколько раз .

Автор - dima_dan2012
Дата добавления - 27.03.2016 в 15:06
StoTisteg Дата: Воскресенье, 27.03.2016, 15:19 | Сообщение № 6
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
dima_dan2012, способов "испортить данные" существует столько, что мы с Вами все не предусмотрим. Однако хранить устаревшие ненужные данные, да ещё в одной свалке с нужными и актуальными — ничуть не лучше. Запустите несколько раз Ваш макрос и посмотрите, что станет с размером файла и обозримостью результатов. А потом попытайтесь объяснить другому макросу, откуда именно ему брать данные.


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
Сообщениеdima_dan2012, способов "испортить данные" существует столько, что мы с Вами все не предусмотрим. Однако хранить устаревшие ненужные данные, да ещё в одной свалке с нужными и актуальными — ничуть не лучше. Запустите несколько раз Ваш макрос и посмотрите, что станет с размером файла и обозримостью результатов. А потом попытайтесь объяснить другому макросу, откуда именно ему брать данные.

Автор - StoTisteg
Дата добавления - 27.03.2016 в 15:19
StoTisteg Дата: Воскресенье, 27.03.2016, 15:31 | Сообщение № 7
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Я уж не говорю о том, что непонятна религия, мешающая перенести сразу всё на новый лист и обрабатывать там:
[vba]
Код
Sub test()

    Dim i As Integer
    Dim Sht as String
   
    Sht=ActiveSheet.Name
    Worksheets.Add After:=Worksheets(Sheets.Count)
    Worksheets(Sht).Cells.Copy Destination:=Cells
    i = 1
    Do While i < Cells(Rows.Count, 1).End(xlUp).Row
        If val(Cells(i, 1).Value) = 2 Then
            Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            i = i + 2
            Else: i = i + 1
        End If
    Loop

End Sub
[/vba]
И да:
Цитата
[vba]
Код
ThisWorkbook.Sheets(3).UsedRange.Clear
[/vba]

Очищать не Вами созданный лист, на котором могут быть данные (и о котором Вам вообще неизвестно, есть ли он) — это тоже не good path... И да, кто Вам сказал, что данные непременно находятся в книге с макросом?


Интуитивно понятный код - это когда интуитивно понятно, что это код.

Сообщение отредактировал StoTisteg - Воскресенье, 27.03.2016, 15:34
 
Ответить
СообщениеЯ уж не говорю о том, что непонятна религия, мешающая перенести сразу всё на новый лист и обрабатывать там:
[vba]
Код
Sub test()

    Dim i As Integer
    Dim Sht as String
   
    Sht=ActiveSheet.Name
    Worksheets.Add After:=Worksheets(Sheets.Count)
    Worksheets(Sht).Cells.Copy Destination:=Cells
    i = 1
    Do While i < Cells(Rows.Count, 1).End(xlUp).Row
        If val(Cells(i, 1).Value) = 2 Then
            Rows(i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            i = i + 2
            Else: i = i + 1
        End If
    Loop

End Sub
[/vba]
И да:
Цитата
[vba]
Код
ThisWorkbook.Sheets(3).UsedRange.Clear
[/vba]

Очищать не Вами созданный лист, на котором могут быть данные (и о котором Вам вообще неизвестно, есть ли он) — это тоже не good path... И да, кто Вам сказал, что данные непременно находятся в книге с макросом?

Автор - StoTisteg
Дата добавления - 27.03.2016 в 15:31
ant6729 Дата: Воскресенье, 27.03.2016, 16:10 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Спасибо всем!
 
Ответить
СообщениеСпасибо всем!

Автор - ant6729
Дата добавления - 27.03.2016 в 16:10
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставка пустых строк после 2 (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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