Макрос, по добавлению значений в прайс лист

Старая форма входа

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

Макрос, по добавлению значений в прайс лист (Макросы Sub)

wwizard

Дата: Пятница, 30.08.2013, 19:54 | Сообщение № 1

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

Ранг: Форумчанин

Сообщений: 176

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

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

Есть прайс "Micro" (на 24 000 строки)
У прайса есть два листа.
На листе 1 сам прайс.
На Листе 2 условие для макроса. (если можно обойтись без него буду очень благодарен.)

Что требуется:
В данном прайсе в 1ом столбце встречается название категории, и встречается имя производителя. Нужен макрос, который сможет их разделить и вывести в отдельные столбцы: Столбец №10 Выводить категорию: (Например [HD Медиаплееры]). а в столбец №11 выводить производителя, если такой указан на листе 2 (если можно обойтись без условий в листе 2, буду очень признателен)

К сообщению приложен файл: Micro.xlsx (23.9 Kb)

Ответить

_Boroda_

Дата: Пятница, 30.08.2013, 21:45 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 16738

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

Замечаний: ±

2003; 2007; 2010; 2013 RUS

[vba]

Код

Sub tt()
Application.ScreenUpdating = 0
r_ = Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To r_
     If IsNumeric(Range("A" & i)) Then
         Range("J" & i - 1 & ":K" & i - 1).Copy Range("J" & i & ":K" & i)
     ElseIf IsNumeric(Range("A" & i + 1)) Then
         Range("J" & i) = Range("J" & i - 1)
         Range("K" & i) = Range("A" & i)
     Else
         Range("J" & i) = Range("A" & i)
         Range("K" & i) = Range("A" & i + 1)
     End If
Next i
For i = 3 To r_ ' Удаление. Можно этот цикл не делать вообще.
     If Not IsNumeric(Range("A" & i)) Then
         Range("J" & i & ":K" & i).ClearContents
     End If
Next i
Application.ScreenUpdating = 1
End Sub

[/vba]

К сообщению приложен файл: Micro_1.xlsm (32.8 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

wwizard

Дата: Суббота, 31.08.2013, 02:29 | Сообщение № 3

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

Ранг: Форумчанин

Сообщений: 176

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

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

Супер, спасибо огромное. Еще маленький вопрос,
в некоторых ячейках 4го столбца попадаются такие надписи: Ожид. (90), Ожид. (120) и другие, возможно ли чтото добавить в макрос чтобы убирались буквенные значения и скобки (в общем все символы) и оставлялись только цифры там же, в тех же ячейках, т.е. 90, 120

Ответить

SergeyKorotun

Дата: Суббота, 31.08.2013, 05:12 | Сообщение № 4

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

Ранг: Обитатель

Сообщений: 301

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

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

Excel 2007

[vba]

Код

Sub tt()
Application.ScreenUpdating = 0
r_ = Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To r_

     DelSymb (i)

     If IsNumeric(Range("A" & i)) Then
         Range("J" & i - 1 & ":K" & i - 1).Copy Range("J" & i & ":K" & i)
     ElseIf IsNumeric(Range("A" & i + 1)) Then
         Range("J" & i) = Range("J" & i - 1)
         Range("K" & i) = Range("A" & i)
     Else
         Range("J" & i) = Range("A" & i)
         Range("K" & i) = Range("A" & i + 1)
     End If
Next i
For i = 3 To r_ ' Удаление. Можно этот цикл не делать вообще.
     If Not IsNumeric(Range("A" & i)) Then
         Range("J" & i & ":K" & i).ClearContents
     End If
Next i
Application.ScreenUpdating = 1
End Sub

Private Sub DelSymb(i As Long)
     Dim n As Long
     Str_ = Range("D" & i).Value
     n = InStr(1, Str_, "(", vbTextCompare)
     If n > 0 Then
        Range("D" & i).Value = Replace(Str_, Left(Str_, n), "")
     End If
     Str_ = Range("D" & i).Value
     n = InStr(1, Str_, ")", vbTextCompare)
     If n > 0 Then
        Range("D" & i).Value = Replace(Str_, Right(Str_, Len(Str_) - n + 1), "")
     End If
End Sub

[/vba]

Ответить

Макрос, по добавлению значений в прайс лист (Макросы Sub)

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