Переместить данные в отдельную ячейку и удалить ненужные.

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Переместить данные в отдельную ячейку и удалить ненужные. (Формулы/Formulas)

Mark1976

Дата: Воскресенье, 12.03.2017, 08:12 | Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 807

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

Здравствуйте. Есть таблица из 1С. Мне надо привести данные в нормальный вид. Результат хотелось бы видеть как на листе1. Сможете помочь?

К сообщению приложен файл: 0092663.xls (20.0 Kb)

Ответить

Wasilich

Дата: Воскресенье, 12.03.2017, 08:42 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация: 326 ±

Замечаний: 0% ±

2003

Цитата Mark1976, 12.03.2017 в 08:12, в сообщении № 1 ()

Сможете помочь?

Попробуем.
[vba]

Код

Sub www()
  Application.ScreenUpdating = False
  ActiveSheet.UsedRange.UnMerge
  Columns("A:A").Insert Shift:=xlToRight
  Range("B1").Copy Range("A1")
  Range("A1") = "АУ"
  For i = 2 To Range("b" & Rows.Count).End(xlUp).Row Step 2
       Cells(i + 1, "A") = Cells(i, "B")
  Next
  ActiveSheet.UsedRange.Columns(3).SpecialCells(4).EntireRow.Delete
  Application.ScreenUpdating = True
End Sub

[/vba]

Сообщение отредактировал Wasilich - Воскресенье, 12.03.2017, 08:44

Ответить

Mark1976

Дата: Воскресенье, 12.03.2017, 09:28 | Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 807

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

Wasilich, все отлично. Я не учел один момент. В одном АУ может быть несколько строк.

К сообщению приложен файл: 2_1.xls (19.5 Kb)

Ответить

Wasilich

Дата: Воскресенье, 12.03.2017, 17:39 | Сообщение № 4

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация: 326 ±

Замечаний: 0% ±

2003

Цитата Mark1976, 12.03.2017 в 09:28, в сообщении № 3 ()

Я не учел один момент.

А пора бы, 3 года на форуме.
[vba]

Код

For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
       If Cells(i, "C") = "" Then
         au = Cells(i, "B")
       Else
         Cells(i, "A") = au
       End If
  Next

[/vba]

Ответить

Mark1976

Дата: Воскресенье, 12.03.2017, 20:36 | Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 807

Репутация: 3 ±

Замечаний: 0% ±

Excel 2010, 2013

Wasilich, спасибо. Согласен, есть косяк . Но иногда мысль приходит не сразу. За макрос огромное спасибо.

Сообщение отредактировал Mark1976 - Воскресенье, 12.03.2017, 20:51

Ответить

Переместить данные в отдельную ячейку и удалить ненужные. (Формулы/Formulas)

Страница 1 из 1
1