Здравствуйте, помогите мне пожалуйста переформатировать таблицу прайса с помощью скрипта, т.к. у поставщика сделано группами, и я не могу добавить в бухгалтерию. Раньше справлялся вручную, но теперь требуется ежедневная обработка прайса. На мне много обязанностей, и не хватает время на изучения экселя. Помогите плиз, возможно небольшое вознаграждение за труды. Первая колонка содержит и Тип товара, и Артикул, и Производителя. Думал как-то по цвету определять, т.к. они соблюдаются всегда, только не знаю как реализовать определение и перенос в другую ячейку. Сама задача с примером приведена в прикрепленном примере. Спасибо.
Нашел такой макрос, но он немного лишних данных дублирует, и в вертикальном виде
Код
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
LVL, огромнейшее Вам спасибо, все работает как надо. Очень приятно, что так быстро отозвались помочь. (только столбец
ИН
становится пустым). Там находился артикул производителя.
Ночью k61 помог мне решить несколько проблем, и сидел до утра, поэтому как и обещал - отблагодарю. Но Вас тоже хочу немного поблагодарить, т.к. Вы тоже потратили время, не зная что мне уже помогают. Скиньте в личку ном. тел. З.Ы. Первый форум куда я обратился, и приятно удивлен отзывчивостью людей сайта. Спасибо всем.