MS Excel - решение практических задач

В этой теме размещаем вопросы и ответы, а также советы и рекомендации по решению конкретных задач, которые требуют создания формулы, применения макроса, написания кода VBA, т.е. Практикум.

------------------------------

Вопросы и ответы, а также советы и рекомендации по настройке MS Excel, ошибки в работе программы, решение задач по импорту/экспорту документов, ссылки и обсуждение надстроек для Excel, обучающие материалы и т.п. размещаем в теме MS Excel - настройка, импорт/экспорт.
Если решение задачи не требует применения формул и макросов (VBA), то это обсуждение будет перенесено в тему по настройкам.

Все пожелания по принципам размещения сообщений по этим темам рассматриваются - пишите в личку Andrey_k.

[The_Prist]

Висит потому, что выделяете весь столбец. А столбец-то небось в 2007 Excel, а это 1048576 строк. Делайте так:

Sub Test()
If TypeName(Selection) <> "Range" Then MsgBox "Выделенная область не является диапазоном!", vbCritical, "Ошибка": Exit Sub
    Dim rCell As Range, rRange as range, a As Integer
    Application.ScreenUpdating = False
    set rRange = Intersect(Selection, ActiveSheet.Usedrange)
    For Each rCell In rRange        
        a = InStr(rCell, " ")
        If a < 6 Then
            rCell = Mid(rCell, a + 1)
        End If
    Next rCell
    Application.ScreenUpdating = True
End Sub

[konstruktor]

собственно сделал табличку, вроде пашет - но на будущее хотел узнать может можно проще?

пример

Цитата: задача стояла так: 1. лист - манагеры набивают заказ (предмет - цвет -кол-во) + заказ округляется до обтимального кол-ва 2. лист - производство считается мат.

[nehgroid]

Цитата: Сообщение от MuhaZ Попробуй Sub Test() If TypeName(Selection) <> "Range" Then MsgBox "Выделенная область не является диапазоном!", vbCritical, "Ошибка": Exit Sub Dim rCell As Range, a As Integer Application.ScreenUpdating = False Selection.Activate For Each rCell In Selection a = InStr(rCell, " ") If a < 6 Then rCell = Mid(rCell, a + 1) End If Next rCell Application.ScreenUpdating = True End Sub

Макрос останавливается только после нажатия "Esc"/

Добавлено через 10 минут

Цитата: Сообщение от DmitriC Прошу прощения, должно быть: Cstr() - это функция, преобразующая аргумент в строку.

Снова ругается:
[IMG][/IMG]

[Vlad_Grizli]

Попробуй функцию "сцепить" посмотреть.

[The_Prist]

Цитата: Сообщение от nehgroid Снова ругается:

Это странно. Ругаться может по одной причине - Вы выделяете диапазон, в котором нет данных:

Вот с проверкой - если диапазон является нулевых - выход из процедуры:

Sub Test()
If TypeName(Selection) <> "Range" Then MsgBox "Выделенная область не является диапазоном!", vbCritical, "Ошибка": Exit Sub
    Dim rCell As Range, rRange As Range, a As Integer
    Set rRange = Intersect(Selection, ActiveSheet.UsedRange)
    If rRange Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For Each rCell In rRange
        a = InStr(rCell, " ")
        If a < 6 Then
            rCell = Mid(rCell, a + 1)
        End If
    Next rCell
    Application.ScreenUpdating = True
End Sub

[DmitriC]

Цитата: Сообщение от nehgroid Снова ругается:

Пример, предложенный The_Prist пытается обработать всю область, заключенную между ячейками, содержащими данные. Например, если в ячейке A1 будет какое-то значение и в ячейке A500 будет значение, то обрабатываться будут все 500 ячеек, несмотря на то, что 498 из них пустые. Поэтому такой подход неоптимален по скорости.

Лучше использовать: Selection.SpecialCells(xlCellTypeConstants). В этом случае будут обрабатываться только те ячейки из выделенного диапазона, которые содержат данные. Причем не просто данные, а константы. То есть формулы и пустые ячейки обрабатываться не будут. Таким образом, в нашей ситуации с A1-A100 обработаны будут только две ячейки.

Кроме того, в исходном алгоритме есть ошибка вот в этой строке: a = InStr(rCell, " ")

По условию сказано, что удалить нужно все первые слова строк, содержащие меньше 6 символов. В этом месте ищется первый пробел в строке. С помощью него определятся первое слово. НО если строка состоит из одного слова, состоящего, скажем из 3 символов и не содержит пробелов, то результатом функции InStr будет 0 и слово удалено не будет. Для исключения этой ситуации надо просто дописать в конце строки пробел. В этом случае функция гарантированно будет возвращать правильный результат: a = InStr(rCell + " ", " ").

Но среди значений в ячейках могут быть как строки, так и числа. Поэтому перед обработкой строки фeнкцией InStr, надо убедиться, что аргумент, который ей передается - это строка. Для этого используем CStr(). Эта функция числовой аргумент преобразует в строку, а строковый оставит без изменений.

И еще один момент. По условию задачи сказано, что должны удаляться слова, длиной меньше 6 символов. Тогда условие проверки должно быть записано так:

If a < 7 Then rCell.Value = Mid(t, a + 1)

а не так:

If a < 6 Then rCell.Value = Mid(t, a + 1)

потому, что найденная с помощью InStr позиция - это позиция пробела, а не последнего символа первого слова.

В итоге имеем:

Цитата: Sub Test() Dim rCell As Range, a As Integer, t As String Application.ScreenUpdating = False For Each rCell In Selection.SpecialCells(xlCellTypeConstants) t = CStr(rCell.Value) + " " a = InStr(t, " ") If a < 7 Then rCell.Value = Mid(t, a + 1) Next Application.ScreenUpdating = True End Sub

[The_Prist]

Цитата: Сообщение от DmitriC Лучше использовать: Selection.SpecialCells(xlCellTypeConstants).

Согласен, но добавлю пару ложек дегтя. Выделите всего одну ячейку на листе с данными и запустите макрос. Результат будет радостный - обработаны будут все ячейки с константами на листе.
Выделите диапазон, состоящий лишь из формул - ошибка.

Т.е. надо проверять и на кол-во выделенных ячеек и на наличие констант. Т.е. получиться так:

Sub Test()
    Dim rCell As Range, rRange As Range, a As Integer, t As String
    Application.ScreenUpdating = False
    If Selection.Count = 1 Then
        If ActiveCell.HasFormula = False Then
            If Len(ActiveCell.Text) > 0 Then Set rRange = ActiveCell
        End If
    Else
        On Error Resume Next
        rRange = Selection.SpecialCells(xlCellTypeConstants)
    End If
    If rRange Is Nothing Then Exit Sub
    On Error GoTo 0

    For Each rCell In rRange
        t = CStr(rCell.Text) & " "
        a = InStr(t, " ")
        If a < 7 Then rCell.Value = Mid(t, a + 1)
    Next
    Application.ScreenUpdating = True
End Sub

И еще: не факт, что человек не хочет обрабатывать формулы. Возможно даже наоборот - данные смешаны. Но это уже пусть автор решает, что ему нужно.

[DmitriC]

Цитата: Сообщение от The_Prist Согласен, но добавлю пару ложек дегтя. Выделите всего одну ячейку на листе с данными и запустите макрос. Результат будет радостный - обработаны будут все ячейки с константами на листе. Выделите диапазон, состоящий лишь из формул - ошибка. Т.е. надо проверять и на кол-во выделенных ячеек и на наличие констант. Т.е. получиться так:

Верно, это я не учел. Тогда для красоты еще чуть-чуть причешем:

Sub Test()
  Dim rCell As Range, rRange As Range, a As Integer, t As String

  Application.ScreenUpdating = False
  
  Set rRange = Nothing
  On Error Resume Next
  
  If Selection.Count > 1 Then
   Set rRange = Selection.SpecialCells(xlCellTypeConstants)
  Else
   If Not (ActiveCell.HasFormula Or ActiveCell = Empty) Then Set rRange = ActiveCell
  End If

  If rRange Is Nothing Then Exit Sub
  
  For Each rCell In rRange
   t = CStr(rCell.Value) + " "
   a = InStr(t, " ")
   If a < 7 Then rCell.Value = Mid(t, a + 1)
  Next

  Application.ScreenUpdating = True
End Sub

Цитата: И еще: не факт, что человек не хочет обрабатывать формулы. Возможно даже наоборот - данные смешаны. Но это уже пусть автор решает, что ему нужно.

Согласен.

[MuhaZ]

Цитата: Сообщение от nehgroid Макрос останавливается только после нажатия "Esc"/

Какой объем обработки?
Попробуйте, плз, еще раз. Со счетчиком, который будет показывать
- какая ячейка по счету обрабатывается,
- что макрос не завис.
Так же добавил обработку пустых ячеек. Скорость возросла в два раза (но на пустом диапазоне в три столбца - при заполненом диапазоне скорость возрастет меньше)

Sub Test()
Dim nCell As Double ' счетчик обрабатываемых ячеек, если ячеек будет много смените тип
If TypeName(Selection) <> "Range" Then MsgBox "Выделенная область не является диапазоном!", vbCritical, "Ошибка": Exit Sub
    Dim rCell As Range, a As Integer
    Application.ScreenUpdating = False

    Selection.Activate
    nCell = 0
    For Each rCell In Selection
        Application.StatusBar = "Обрабатываю " & nCell 'Сообщение в статусной строке
        If a = 0 Then
            a = InStr(rCell, " ")
            If a < 6 Then
                rCell = Mid(rCell, a + 1)
            End If
        End If
        nCell = nCell + 1
    Next rCell
    Application.ScreenUpdating = True
    'Application.StatusBar = False 'После отладки раскоментировать
End Sub

В любом случае, при обработке больших массивов предусматривайте вывод промежуточных сообщений, либо используйте точки останова с просмотром результатов в редакторе VB.

[DmitriC]

Цитата: Сообщение от konstruktor а моё ?

У тебя документ с большим количеством взаимосвязанных формул и данных. С ним надо разбираться. Уточни что именно тебе там не нравится и можно попробовать заняться оптимизацией. А так...

[konstruktor]

мне не нравится, что я день убил чтоб его сделать

наверняка можно проще (желательно без макросов)

1. выбрал изделие из списка (у меня список разбит по 20 изделий в группе) - это минус.. ограничение (хотелось бы больше, но при моём "подходе" формула шибко длинная будет.. много вложений)
2. выбрал цвет изделия - тут ровно все
3. должно под грузиться число (по которому идет округление заказа)

[nehgroid]

Цитата: Сообщение от MuhaZ Какой объем обработки? Попробуйте, плз, еще раз. Со счетчиком, который будет показывать - какая ячейка по счету обрабатывается, - что макрос не завис. Так же добавил обработку пустых ячеек. Скорость возросла в два раза (но на пустом диапазоне в три столбца - при заполненом диапазоне скорость возрастет меньше) Sub Test() Dim nCell As Double ' счетчик обрабатываемых ячеек, если ячеек будет много смените тип If TypeName(Selection) <> "Range" Then MsgBox "Выделенная область не является диапазоном!", vbCritical, "Ошибка": Exit Sub Dim rCell As Range, a As Integer Application.ScreenUpdating = False Selection.Activate nCell = 0 For Each rCell In Selection Application.StatusBar = "Обрабатываю " & nCell 'Сообщение в статусной строке If a = 0 Then a = InStr(rCell, " ") If a < 6 Then rCell = Mid(rCell, a + 1) End If End If nCell = nCell + 1 Next rCell Application.ScreenUpdating = True 'Application.StatusBar = False 'После отладки раскоментировать End Sub В любом случае, при обработке больших массивов предусматривайте вывод промежуточных сообщений, либо используйте точки останова с просмотром результатов в редакторе VB.

Этот код не работает...
Работает от The_Prist и от DmitriC
Всем спасибо!!!

[DmitriC]

Цитата: Сообщение от konstruktor мне не нравится, что я день убил чтоб его сделать наверняка можно проще (желательно без макросов) 1. выбрал изделие из списка (у меня список разбит по 20 изделий в группе) - это минус.. ограничение (хотелось бы больше, но при моём "подходе" формула шибко длинная будет.. много вложений) 2. выбрал цвет изделия - тут ровно все 3. должно под грузиться число (по которому идет округление заказа)

В общем, смотри что получилось. Это только предварительное упрощение, т. к. непонятен смысл таблицы "материалы (листов)" на листе"производство), а именно почему в ячейках этой таблицы устанавливаются полные суммы. Я пометил желтым то, что мне неясно. Ну и из листа "заявки" выброшены все промежуточные расчеты, т. к. они не нужны.

Изменения сделаны только для товаров первой группы. Остальное - по аналогии.

primer

[konstruktor]

лист "производство" - это отчет цеха по материалам.
лист "предметы" - справочник (название, кол-во для оптимального заказа), кол-во материалов, кол-во фурнитуры

там в формуле идет проверка двух условий:
1. название предмета
2. цвет

выявив "нужный" предмет, табл. выясняет цвет, затем в ячейку ставится кол-во листов данного цвета

З. Ы. за формулу реально спасибо, много короче.. выходит... только она выдает номер позиции, а нужно число (оно не совпадает с номером позиции) - кол-во для оптим. раскроя (столбец D на листе !предметы) чувствую что нужен ВПР но не могу с ним совладать...

[DmitriC]

Цитата: Сообщение от konstruktor лист "производство" - это отчет цеха по материалам. лист "предметы" - справочник (название, кол-во для оптимального заказа), кол-во материалов, кол-во фурнитуры там в формуле идет проверка двух условий: 1. название предмета 2. цвет выявив "нужный" предмет, табл. выясняет цвет, затем в ячейку ставится кол-во листов данного цвета З. Ы. за формулу реально спасибо, много короче.. выходит... только она выдает номер позиции, а нужно число (оно не совпадает с номером позиции) - кол-во для оптим. раскроя (столбец D на листе !предметы) чувствую что нужен ВПР но не могу с ним совладать...

В таком случае формулу можно заменить на:

=ЕСЛИ(ЕПУСТО(B4);;ИНДЕКС(предметы!D$4:D$23;ПОИСКПОЗ(B4;кухонные_уголки;0)))

Там не только эта формула. Самая прелесть на листе "предметы" в таблице [H4:M23].
Заодно вопрос: если несколько раз выбрать один и тот же товар ОДНОГО цвета, то в таблице "материалы (листов)" каждый раз напротив выбранного товара указывается суммарное количество предметов (я этот момент желтым цветом пометил). Так и должно быть, или это у тебя ошибка? Потому что с формулами в этой таблице тоже надо что-то делать и перед переделкой хочется быть уверенным, что там ничего не напутано.