Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Переформатирование Прайс-листа, Разбивка макросом ячеек таблицы прайса
 
Здравствуйте, помогите мне пожалуйста переформатировать таблицу прайса с помощью скрипта, т.к. у поставщика сделано группами, и я не могу добавить в бухгалтерию. Раньше справлялся вручную, но теперь требуется ежедневная обработка прайса. На мне много обязанностей, и не хватает время на изучения экселя.
Помогите плиз, возможно небольшое вознаграждение за труды.
Первая колонка содержит и Тип товара, и Артикул, и Производителя.
Думал как-то по цвету определять, т.к. они соблюдаются всегда, только не знаю как реализовать определение и перенос в другую ячейку.
Сама задача с примером приведена в прикрепленном примере.
Спасибо.

Скрытый текст
Изменено: iplus - 5 Мар 2015 04:28:31
 
Нашел такой макрос, но он немного лишних данных дублирует, и в вертикальном виде
Код
Sub Redesigner()    Dim inpdata As Range, realdata As Range, ns As Worksheet
    Dim i&, j&, k&, c&, r&, hc&, hr&
    Dim out(), dataArr, hcArr, hrArr
    
    Set inpdata = ThisWorkbook.Application.InputBox( _
     prompt:="Âûáåðèòå îáðàáàòûâàåìûé äèàïàçîí:", Title:="Âûáîð äèàïàçîíà", Type:=8)
    
      hr = Val(InputBox("Ñêîëüêî ñòðîê ñ ïîäïèñÿìè ñâåðõó?"))
      hc = Val(InputBox("Ñêîëüêî ñòîëáöîâ ñ ïîäïèñÿìè ñëåâà?"))
   
    If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
    Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
    dataArr = realdata.Value
    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value
    If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value
    
    ReDim out(1 To realdata.Count, 1 To hr + hc + 1)
    'ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
    Set ns = Worksheets.Add
    
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            'If Not IsEmpty(dataArr(i, j)) Then
               k = k + 1
               For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
               For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
               out(k, c + r - 1) = dataArr(i, j)
            'End If
    Next j, i
    ns.Cells(2, 1).Resize(UBound(out, 1), UBound(out, 2)) = out
End Sub

Код оформить можно кнопкой  <...> [МОДЕРАТОР]
Изменено: iplus - 5 Мар 2015 11:16:58
 
Обратите внимание на комментарии про цвет, количество записей определяется по последней заполненной строке во 2 столбце на листе с исходными данными
 
LVL, огромнейшее Вам спасибо, все работает как надо. Очень приятно, что так быстро отозвались помочь. (только столбец
ИН
становится пустым). Там находился артикул производителя.

Ночью k61 помог мне решить несколько проблем, и сидел до утра, поэтому как и обещал - отблагодарю.
Но Вас тоже хочу немного поблагодарить, т.к. Вы тоже потратили время, не зная что мне уже помогают. Скиньте в личку ном. тел.
З.Ы. Первый форум куда я обратился, и приятно удивлен отзывчивостью людей сайта. Спасибо всем.:)
 
Цитата
iplus написал: ИНстановится пустым). Там находился артикул производителя.
Так в вашем примере оно пустое, поэтому и код его пустым оставляет...
Изменено: LVL - 5 Мар 2015 13:19:53
 
Все отлично работает))) Спасибо огромнейшее.
Счет пополнил.
Изменено: iplus - 5 Мар 2015 13:24:16
 
"Спасибо" получено ;)
Страницы: 1
Читают тему (гостей: 1)