Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Замена текста на число и вывод суммы VBA, Необходимо выполнить замену текста по заданному принципу
 
#1
18.10.2016 13:09:18
Имеется таблица данных, число столбцов фиксированное, число строк растёт в зависимости от заполнения. 2 столбец содержит 4 различных значения - "красный", "жёлтый", "синий", "белый". 3,4,5 столбцы содержат в себе цифру 1 или пустые. Необходимо произвести замену в столбцах 3, 4, 5 по принципу - если в строке указано "красный" то 1 в 3 столбце будет 5, 1 в 4 столбце будет 10, 1 в 5 столбце будет 15, если указано "жёлтый", то замена 1 будет произведена на другие числа и т.п.
Прошу ногами не бить, в поиске не смог найти. Прошу помочь.
Изменено: Flinkor - 18.10.2016 13:10:48
 
 
 
#2
18.10.2016 13:23:08
Почему не попробовать применить 4 раза (или 5) вложенные ЕСЛИ() - судя по описанию вполне годится.
Дёшево и сердито. Хотя можно использовать ещё и ВПР() или ВЫБОР() - будет короче запись.
Если так уж необходимо VBA - запишите процесс рекордером, включая итоговый спецкопипаст назад из формул в значения.
Изменено: Hugo - 18.10.2016 13:28:41
 
 
 
#3
18.10.2016 20:23:56
Цитата
Flinkor написал:
если указано "жёлтый", то замена 1 будет произведена на другие числа и т.п...  Прошу помочь.
Начните помогать себе сами: приложите файл, в котором в т.ч. указаны эти "другие числа".
 
 
 
#4
18.10.2016 22:11:36
Я уже прикинул вариант, работает, считает без ошибок. Смысл в том, что человек заполняет таблицу указывая "еднерками" выполненные пункты в каждой категории, а руководитель пересчитывает это все в рубли для предварительной оценки работы. Есть варианты по оптимизации? Как можно реализовать подгрузку соответствий из отдельного листа, на подобии таблицы соответствий, чтобы ценность позиций 9,10,11,12,13 ОМ, ОК, ОБ, ОКБД не в коде прописывать, а в таблице на листе, откуда макрос их заберет. Что добавить в макрос, для создания функции "=промежуточные.итоги(109;ХХ:УУ)" в 3 сроке 14 столбце и шапкой "Итого", охват функции должен быть все строки и столбцы с 9 по 13. Макрос состоит из 2 частей - 1 часть стырил на форуме. Он берет данные в исходной книге, к которой подключены таблицы исполнителей на отдельных листах, и объединяет в одну таблицу, благо кол-во столбцов фиксированное (в идеале), все это дело пихает в новую книгу. Вторую часть макроса придумал сегодня сам, она меняет в общей таблице в новой книге все 1 на кастомные значения.


Код
Sub sborka()
Dim y As Integer
Dim lLastRow As Integer
s_ = Sheets.Count
Workbooks.Add
ThisWorkbook.Sheets(1).Range("1:1").Copy ActiveWorkbook.Sheets(1).Range("a1")
For i = 1 To s_
    r_ = ActiveWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Row + 1
    ThisWorkbook.Sheets(i).Range("a1").CurrentRegion.Offset(1).Copy ActiveWorkbook.Sheets(1).Range("a" & r_)
Next



lLastRow = Cells.SpecialCells(xlLastCell).Row

 For y = 2 To lLastRow
 If Cells(y, 7) = "ОМ" Then
    If Cells(y, 9) = 1 Then Cells(y, 9) = 50
    If Cells(y, 10) = 1 Then Cells(y, 10) = 50
    If Cells(y, 11) = 1 Then Cells(y, 11) = 50
    If Cells(y, 12) = 1 Then Cells(y, 12) = 50
    If Cells(y, 13) = 1 Then Cells(y, 13) = 50
 
 End If
  Next y

 For y = 2 To lLastRow
 If Cells(y, 7) = "ОК" Then
    If Cells(y, 9) = 1 Then Cells(y, 9) = 110
    If Cells(y, 10) = 1 Then Cells(y, 10) = 210
    If Cells(y, 11) = 1 Then Cells(y, 11) = 80
    If Cells(y, 12) = 1 Then Cells(y, 12) = 100
    If Cells(y, 13) = 1 Then Cells(y, 13) = 100
 
 End If
  Next y

 For y = 2 To lLastRow
 If Cells(y, 7) = "ОБ" Then
    If Cells(y, 9) = 1 Then Cells(y, 9) = 210
    If Cells(y, 10) = 1 Then Cells(y, 10) = 310
    If Cells(y, 11) = 1 Then Cells(y, 11) = 160
    If Cells(y, 12) = 1 Then Cells(y, 12) = 160
    If Cells(y, 13) = 1 Then Cells(y, 13) = 160
 
 End If
  Next y
  
  For y = 2 To lLastRow
 If Cells(y, 7) = "ОКБД" Then
    If Cells(y, 9) = 1 Then Cells(y, 9) = 170
    If Cells(y, 10) = 1 Then Cells(y, 10) = 210
    If Cells(y, 11) = 1 Then Cells(y, 11) = 90
    If Cells(y, 12) = 1 Then Cells(y, 12) = 120
    If Cells(y, 13) = 1 Then Cells(y, 13) = 110
 
 End If
  Next y

End Sub
Изменено: Flinkor - 18.10.2016 22:52:01
 
 
 
#5
18.10.2016 22:32:35
Зачем цик 4 раза? Достаточно одного и проверки например с помощью select case значения Cells(y, 7)
Вот например (можно наверное ещё оптимизнуть - но на таком количестве нет необходимости):
Код
    For y = 2 To lLastRow
        Select Case Cells(y, 7)
            Case "ОМ"
                If Cells(y, 9) = 1 Then Cells(y, 9) = 50
                If Cells(y, 10) = 1 Then Cells(y, 10) = 50
                If Cells(y, 11) = 1 Then Cells(y, 11) = 50
                If Cells(y, 12) = 1 Then Cells(y, 12) = 50
                If Cells(y, 13) = 1 Then Cells(y, 13) = 50

            Case "ОК"
                If Cells(y, 9) = 1 Then Cells(y, 9) = 110
                If Cells(y, 10) = 1 Then Cells(y, 10) = 210
                If Cells(y, 11) = 1 Then Cells(y, 11) = 80
                If Cells(y, 12) = 1 Then Cells(y, 12) = 100
                If Cells(y, 13) = 1 Then Cells(y, 13) = 100

            Case "ОБ"
                If Cells(y, 9) = 1 Then Cells(y, 9) = 210
                If Cells(y, 10) = 1 Then Cells(y, 10) = 310
                If Cells(y, 11) = 1 Then Cells(y, 11) = 160
                If Cells(y, 12) = 1 Then Cells(y, 12) = 160
                If Cells(y, 13) = 1 Then Cells(y, 13) = 160

            Case "ОКБД"
                If Cells(y, 9) = 1 Then Cells(y, 9) = 170
                If Cells(y, 10) = 1 Then Cells(y, 10) = 210
                If Cells(y, 11) = 1 Then Cells(y, 11) = 90
                If Cells(y, 12) = 1 Then Cells(y, 12) = 120
                If Cells(y, 13) = 1 Then Cells(y, 13) = 110

        End Select
    Next y
Изменено: Hugo - 18.10.2016 22:43:17
 
 
 
#6
18.10.2016 22:43:33
Flinkor, код следует оформлять соответствующим тегом. Ищите такую кнопку и исправьте своё сообщение.
Спасибо!
 
 
 
#7
18.10.2016 23:02:02
Юрий М, виноват, исправил.
Hugo, спасибо, за подсказку. Объем данных не шибко большой, я заметил свою ошибку с циклами. Как можно связать значения отдельных параметров в "ящиках" ОМ, ОК, ОБ, ОКБД с листом в книге? Чтобы руководитель мог изменить ценность мастики ОК или монтаж ОБ не влезая в макрос.
 
 
 
#8
18.10.2016 23:09:38
Ну можно эти пары слово/число/число/... писать на служебный лист и считывать с него - тогда там легко в любой момент всё заменить.
Даже так - в начале макроса считали значения в массив, затем в процессе сверяетесь с массивом.

Код
Например в начале кода

    Dim a()
    a = Sheets("служебный").[a1].CurrentRegion.Value

ну и в цикле тогда

    For y = 2 To lLastRow
        Select Case Cells(y, 7)
            Case a(1, 1)
                If Cells(y, 9) = 1 Then Cells(y, 9) = a(1, 2)
                If Cells(y, 10) = 1 Then Cells(y, 10) = a(1, 3)
                If Cells(y, 11) = 1 Then Cells(y, 11) = a(1, 4)
                If Cells(y, 12) = 1 Then Cells(y, 12) = a(1, 5)
                If Cells(y, 13) = 1 Then Cells(y, 13) = a(1, 6)

и т.д.


А на листе "служебный" с A1 список

ОМ 50 50 50 50 50
ОК 110 210 80 100 100
ОБ 210 310 160 160 160
ОКБД 170 210 90 120 110

Ну а если список этих ОКБ большой - то тогда в начале значения с служебного листа в словарь, каждому наименованию массив его чисел, далее в цикле идём в словарь и берём нужный массив по ключу (если ключ есть в словаре).
Или даже так - ключ можно делать составной, например для пары "ОКБД|9|1" значение 170, а для "ОКБД|10|1" значение 210, тогда для каждой ячейки ряда будет в словаре своё значение, так даже проще, не нужно возиться с массивом этих чисел.
Сразу составили для ячейки строки ключ - взяли значение из словаря, если там есть такой ключ.
Изучайте словари :)
Изменено: Hugo - 18.10.2016 23:29:37
 
 
 
Страницы: 1
Читают тему
Наверх