Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 След.
Подсчёт уникальных значений по нескольким критериям
 
Kalyam, не самый оптимальный вариант, но оптимизировать лениво:
Код
'Диапазон условия, условие, диапазон флага, флаг, столбец по которому считаем уникальные
Function ololo(Range1 As Range, City As String, range2 As Range, Flag As String, Range3 As Range)
Dim MyCell As Object, myDictionary As Object
Dim MyItem As Variant
Dim Counter As Long

If Range1.Count <> range2.Count Or Range1.Count <> Range3.Count Then ololo = "Ошибка"

Set myDictionary = CreateObject("Scripting.Dictionary")

On Error Resume Next
For Each MyCell In Range3
  myDictionary.Add CStr(MyCell), CStr(MyCell)
Next
On Error GoTo 0
Err.Clear

For Each MyItem In myDictionary.Items
    If WorksheetFunction.CountIfs(Range1, City, range2, Flag, Range3, MyItem) > 0 Then
        Counter = Counter + 1
    End If
Next

ololo = Counter

End Function
Пример использования:
=ololo($D$2:$D$40;G2;$E$2:$E$40;$E$4;$B$2:$B$40)
Подсчёт уникальных значений по нескольким критериям
 
Kalyam, несколько городов в одном акте могут быть? Если да, то как учитывать?
Подсчёт уникальных значений по нескольким критериям
 
Kalyam, считаться должны только записи, в которых выполняется условие по городу и гр с учётом уникальности по столбцу B?
Подсчёт уникальных значений по нескольким критериям
 
Kalyam, формула массива:
=СУММ(($C$2:$C$55=1)*($D$2:$D$55=G2)*($E$2:$E$55="гр"))

обычный СЧЁТЕСЛИМН:
=СЧЁТЕСЛИМН(D:D;G2;C:C;1;E:E;"гр")
Изменено: Polkilo - 23 Янв 2020 16:04:31
Получить данные из другой ячейки при условии, что ячейка совпадает с искомой.
 
evghtcone, =ИНДЕКС($D$1:$G$1;1;ПОИСКПОЗ(C2;D2:G2;0))
Номера телефонов привести к единому формату
 
Андрей VG, благодарю, до регулярок пока не добрался, слишком редко возникает необходимость работы с текстом. Покурю на досуге)
Номера телефонов привести к единому формату
 
Андрей VG, Тут как посмотреть, мне, к примеру, проще хранить одну универсальную процедуру, чем плодить под каждый желаемый формат.
Так что для форума такое решение может быть полезным.
Номера телефонов привести к единому формату
 
Паразитируя на коде Михаил Лебедева:
Код
Sub ОдинФормат()
    Dim r As Range
    Dim rng As Range
    Dim NumberFormat As String
    
    Set rng = Application.InputBox("Выделите блок ячеек", "Выделите блок ячеек", , , , , , 8) 'Выбираем диапазон
    NumberFormat = InputBox("Укажите формат где 0 это цифра номера", "Желаемый формат", "+7 (000) 000-00-00") 'Указываем формат
    For Each r In rng
        r.Value = ТолькоЦифры(r.Value, NumberFormat)
    Next
End Sub

Function ТолькоЦифры(ByVal строка As String, формат As String) As String
    Dim i As Integer
    Dim цифры As String
    Dim цифра As String
    
    If Len(строка) >= 1 Then
        For i = 1 To Len(строка)
           цифра = Mid(строка, i, 1)
            If IsNumeric(цифра) Then
               цифры = цифры & цифра
             End If
        Next
        цифры = Right(цифры, 10)
        ТолькоЦифры = Application.WorksheetFunction.Text(цифры, формат)
    End If
End Function

Изменено: Polkilo - 16 Янв 2020 09:24:32
Номера телефонов привести к единому формату
 
maves, проверяйте
Код
Sub ololo()
Dim i As Long
Dim MyPhone As String

For i = 3 To ThisWorkbook.Sheets("Форма").Cells(Rows.Count, 9).End(xlUp).Row 'Крутим цикл по 9 столбцу за исключением шапки
    MyPhone = OnlyNumbers(ThisWorkbook.Sheets("Форма").Cells(i, 9)) 'Оставляем в номере только цифры
    If Len(MyPhone) >= 10 Then
        MyPhone = Right(MyPhone, 10) 'забираем последние 10 символов
        MyPhone = "+7 (" & Mid(MyPhone, 1, 3) & ") " & Mid(MyPhone, 4, 3) & "-" & Mid(MyPhone, 7, 2) & "-" & Mid(MyPhone, 9, 2) 'Сцепляем
        ThisWorkbook.Sheets("Форма").Cells(i, 9) = MyPhone 'выводим на лист
    End If
Next

End Sub

Function OnlyNumbers(ByVal MyString As String) As String
Dim i As Long
Dim Numbers As String

If Len(MyString) >= 1 Then
    For i = 1 To Len(MyString)
        If IsNumeric(Mid(MyString, i, 1)) Then
            Numbers = Numbers & Mid(MyString, i, 1)
        End If
    Next
    OnlyNumbers = CStr(Numbers)
End If

End Function
Изменено: Polkilo - 15 Янв 2020 13:21:19
Номера телефонов привести к единому формату
 
maves, учтите, после +7 пробела нет, если он нужен, то оберните еще раз в ПОДСТАВИТЬ и замените "(" на " ("
Нумерология: цифры вместо букв по таблице
 
petrrusanov,
Код
=СУММПРОИЗВ(ОСТАТ(ПОИСК(ПСТР(A1;СТРОКА(ДВССЫЛ("1:"&ДЛСТР(A1)));1);
"абвгдеёжзийклмнопрстуфхцчшщъыьэюя")-1;9)+1)
Изменение диапазона суммирования по условию
 
Паразитирую на формуле массива Wiss
Код
=ЕСЛИ(СУММ(--(B5:M5=A14);--(B5:M5=A15))>0;СУММПРОИЗВ($B$6:$M$6;--(СТОЛБЕЦ($B$6:$M$6)>=МИН(ЕСЛИОШИБКА(СТОЛБЕЦ(B6:$M$6)/--(($B$5:$M$5="ТО")+($B$5:$M$5="ТР"));999))));СУММ(B6:M6))
Изменено: Polkilo - 30 Дек 2019 18:10:05
Изменение диапазона суммирования по условию
 
artem1908, Могут ли встречаться несколько таких ячеек в диапазоне? Как поступать в этом случае?
Выполнение действий, если поиском найдено значение
 
Robot JORDAN, как определить, что является кратким описанием процесса обработки?
"Рубка листа" - первое слово;
"Ручная гибка" - второе слово;
"Снятие заусенцев с контура детали вручную" - два первых слова.

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

Цеху, обычно, предоставляется чертёж, а не "Фрезеровать пазы 64,5 минуты".
Или мы не понимаем друг друга.
Изменено: Polkilo - 30 Дек 2019 13:46:48
Выполнение действий, если поиском найдено значение
 
Robot JORDAN, При текущей структуре листа "Время-деталь" это гарантированный геморрой без гарантии результата:

"Зачистка заусенцев" присутствует при всех процедурах в слесарке.
Вам необходимо итоговое время обработки в цеху, а не сумма операций (Вы не указали в списке операций закрепление заготовки)
Выполнение действий, если поиском найдено значение
 
Цитата
Robot JORDAN написал:
Хотелось бы именно выполнение по условию, если найдено.
Так?

Код
If Not Range("D:D").Find(what:="нарезка резьбы") Is Nothing Then
        MsgBox "Нашёл нарезанную рыбу", vbInformation
Else
        MsgBox "Рыба не нарезана", vbInformation
End If 

Что за условия?

Есть их список?

Если из 1000 строк в столбце условие выполнено для одной ячейки выполнять "те или иные действия"?
Изменено: Polkilo - 27 Дек 2019 12:30:34
Если ячейка желтого цвета, то значение другой = 1
 
UDF, работает с одной ячейкой, возвращает 0 или 1
Код
Function GYC(ByVal rng As Range) As Variant

If rng.Cells.Count > 1 Then
    GYC = "Range_Error"
    Exit Function
End If

If rng.Interior.Color = vbYellow Then
    GYC = 1
Else
    GYC = 0
End If

End Function
Если ячейка желтого цвета, то значение другой = 1
 

Для жёлтого:

Код
Sub lol()
If ThisWorkbook.Sheets(1).Cells(1, 1).Interior.Color = vbYellow Then ThisWorkbook.Sheets(1).Cells(1, 2) = 1
end sub

Насколько Ваш "зеленый желтый цвет" желтый проверяйте через

Код
msgbox ThisWorkbook.Sheets(1).Cells(1, 1).Interior.Color

Изменено: Polkilo - 26 Дек 2019 15:05:58
[ Закрыто] Помогите пожалуйста, проблема с ВПР!!!!!, Выдается ошибка #Н/Д
 
psevdokaif, предложите адекватное название темы (какую проблему нужно решить?), приложите файл пример на 10-15 строк с данными.

Помогать сейчас смысла нет, ответ все равно скроют.
Ошибка вычисления внутри ЕСЛИ()
 
RAN, после выбора ячейки D1 на редактирование, ошибка пропадает
Как вариант округлить до 14 знака (или какая точность Вам нужна)
Изменено: Polkilo - 29 Ноя 2019 11:54:34
Отобразить последнюю дату ячейки с текстом
 

Включаем макрорекодер, вводим формулу, получаем:

Код
ActiveCell.FormulaR1C1 = "=IF(TODAY()-7>--MID(RC[-1],FIND(CHAR(1),SUBSTITUTE(RC[-1],""["",CHAR(1),LEN(RC[-1])-LEN(SUBSTITUTE(RC[-1],""["",""""))))+5,10),""Комментарий не обновлён"",""Всё ОК"")"
Изменено: Polkilo - 27 Ноя 2019 12:06:04
Отобразить последнюю дату ячейки с текстом
 
Рассматривается вариант только через формулу?

Оффтоп: "Мы добавили формулы в твой макросы, чтобы ты использовал формулы, используя макрос" (xzibit)
Изменено: Polkilo - 27 Ноя 2019 10:03:41
Отобразить последнюю дату ячейки с текстом
 
Что-то такое получилось:
Код
=ЕСЛИ(СЕГОДНЯ()-7>--ПСТР(P2;НАЙТИ(СИМВОЛ(1);ПОДСТАВИТЬ(P2;"[";СИМВОЛ(1);ДЛСТР(P2)-ДЛСТР(ПОДСТАВИТЬ(P2;"[";""))))+5;10);"Комментарий не обновлён";"Всё ОК")

Поиск последней даты в тексте

Изменено: Polkilo - 25 Ноя 2019 14:06:03
ВПР макросом возвращает неправильный результат
 
xlankasterx, функция возвращает ошибку при отсутствии искомого значения. Используйте IfError.
Изменено: Polkilo - 20 Ноя 2019 10:18:26
Поиск дублей в книге, Как найти дубли во всей книге
 
ulka5659,IF на следующую строку перенесите
Код
Бла-бла-бла
Next    
    If s < 2 Then
        Cell_job = ""
    End If
Проблема с установкой пароля VBA/вручную, Установка пароля на вкладку через VBA и вручную даёт разные результаты
 
Wercasodas, в двоеточии перед знаком равно
Код
ShtIn.Protect Password:="Random"
Кнопки в excel, раскрывающие столбцы
 
Иар, в логику умышленно заложена проверка только значения ToggleButton1? Если нет, то поменяйте:

ToggleButton1.Value в обработчиках 2 и 3 на проверку СВОИХ значений.
Изменено: Polkilo - 18 Ноя 2019 13:26:55
Кнопки в excel, раскрывающие столбцы
 
Цитата
Иар написал:
В excel создала 3 кнопки
Где?
Почему не известен тип данных
 
borro, подключите библиотеку Microsoft XML, v6.0
формула в иксель, опять завсегдатаи резвятся )
 
О, вразумительное название темы подвезли, осталось файл с примером)
Страницы: 1 2 След.
Наверх