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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 217 След.
Реализовать таблицу по подсчету и контролю продовольствия
 
nipolka, см. #2
Изменено: Mershik - 17 янв 2021 21:36:24
Не бойтесь совершенства. Вам его не достичь.
Реализовать таблицу по подсчету и контролю продовольствия
 
nipolka, создавайте тему по конкретному вопросу и все  
Не бойтесь совершенства. Вам его не достичь.
Реализовать таблицу по подсчету и контролю продовольствия
 
nipolka,для раздумий - на плюс минус двойным кликом, а еще у вас общая тема такию тут в разделе работа решают, а в этой ветке конкретный вопрос
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
Dim Product As Range, dataa As Range 'объявление переменных
If Not Intersect(Target, Range("i19,k19,m19,o19,q19,s19,u19,w19")) Is Nothing Then ' отслеживание двоеного нажатия на указанные ячейки
    Target.Offset(0, -1) = Target.Offset(0, -1) + 1 'если одна из указанных выше ячеек тогда прибавляем 1 к значению
    Set Product = Columns(27).Find(Target.Offset(-1, -1)) 'ищем продукт которому добавляли 
    Set dataa = Rows(15).Find(Date) 'ищем сегодняшнюю дату
    Cells(Product.Row, dataa.Column + 1) = Cells(Product.Row, dataa.Column + 1) + 1 'добавляем единичку под сегодняшней датой в столбец приход
    Cancel = True
End If
If Not Intersect(Target, Range("i20,k20,m20,o20,q20,s20,u20,w20")) Is Nothing Then ' отслеживание двоеного нажатия на указанные ячейки
    Target.Offset(-1, -1) = Target.Offset(-1, -1) - 1'если одна из указанных выше ячеек тогда прибавляем 1 к значению
    Set Product = Columns(27).Find(Target.Offset(-2, -1)) 'ищем продукт у которого отнимали
    Set dataa = Rows(15).Find(Date) 'ищем сегодняшнюю дату
    Cells(Product.Row, dataa.Column) = Cells(Product.Row, dataa.Column) - 1 'отнимаем единичку под сегодняшней датой в столбец расход
    Cancel = True
End If
End Sub
Изменено: Mershik - 17 янв 2021 21:35:20
Не бойтесь совершенства. Вам его не достичь.
Запрет ввода данных в ячейку по заданным условиям, Запрет ввода данных в ячейку по заданным условиям
 
Sashat1705,пишите макрос клоьлоый будет проверять ячейку B2 и в случае если там не проценты ставил защиту на лист.
Не бойтесь совершенства. Вам его не достичь.
Из столбиков в один столбик, Доброго дня, помогите решить такую задачу мне нужно из множество столбиков свести в один.
 
vikttur,преобразование кросс-таблицы в плоскую)
Не бойтесь совершенства. Вам его не достичь.
Из столбиков в один столбик, Доброго дня, помогите решить такую задачу мне нужно из множество столбиков свести в один.
 
Сергей Иванов, еще варик
Код
Sub mrshkei()
Dim i As Long, j As Long, arrIN, arrOUT, k As Long, x As Long
k = 1
arrIN = Range("A1:G4")
x = (UBound(arrIN) - 1) * (UBound(arrIN, 2) - LBound(arrIN, 2))
ReDim arrOUT(1 To x, 1 To 3)
For j = LBound(arrIN) + 1 To UBound(arrIN)
    For i = LBound(arrIN) + 1 To UBound(arrIN, 2) - LBound(arrIN, 2) + 1
        arrOUT(k, 1) = arrIN(j, 1)
        arrOUT(k, 2) = arrIN(1, i)
        arrOUT(k, 3) = arrIN(j, i)
    k = k + 1
    Next i
Next j
Range("A7").Resize(UBound(arrOUT), 3) = arrOUT
End Sub
Не бойтесь совершенства. Вам его не достичь.
Макрос который заменяет сводную таблицу на простую таблицу с сохранением формата ячеек
 
avbook, просто скажу так - в большинстве случаев сводные таблицы называют совсем не то
что имеется ввиду ? так как они могут отличаться только оформлением... вы же это считаете сводной ? -  https://support.microsoft.com/ru-ru/office/%D1%81%D0%BE%D0%B7%D0%B4%D0%B0%D0%BD%D0%B8%D0%B5-%D1%81%D...
Цитата
какая именно будет сводная
Изменено: Mershik - 15 янв 2021 17:34:36
Не бойтесь совершенства. Вам его не достичь.
Макрос который заменяет сводную таблицу на простую таблицу с сохранением формата ячеек
 
avbook,а где хоть одна сводная таблица? и вы не обновляйте ее и все
Не бойтесь совершенства. Вам его не достичь.
Объединение строк по вертикали и фильтрация
 
Цитата
Алексе Егоров написал:
строки объединены
Цитата
Алексе Егоров написал:
Мне нужно пользоваться фильтрами, а это невозможно
вывод измените структуру данных и самое главное избавится от объеденных ячеек
Не бойтесь совершенства. Вам его не достичь.
Извлечение уникальных значений из диапазона
 
БМВ,  :D  
Не бойтесь совершенства. Вам его не достичь.
Извлечение уникальных значений из диапазона
 
Цитата
memo написал:
Кстати, интересно было бы увидеть формульный вариант.
согласен)
только кажется будет тормозить)
и еще вариант (3 млн. ячеек 6 сек. вроде подойдет Вам) - диапазон свой задайте только
Код
Sub mrshkei()
a = Timer
Dim arr, i As Long, j As Long, col As New Collection
arr = Range("D2:AG99999")
For i = LBound(arr) To UBound(arr)
    For j = LBound(arr) To UBound(arr, 2) - LBound(arr, 2) + 1
        On Error Resume Next
        col.Add arr(i, j), CStr(arr(i, j))
    Next j
Next i
ReDim arr(1 To col.Count, 1 To 1)
For i = 1 To col.Count
    arr(i, 1) = col(i)
Next i
Range("AI2").Resize(UBound(arr), 1) = arr
Debug.Print Timer - a
End Sub
Изменено: Mershik - 15 янв 2021 11:58:19
Не бойтесь совершенства. Вам его не достичь.
Зная дату и фамилию, записать значение в ячейку пересечения этих двух параметров
 
Элона Шеверенко, в модуль листа
Код
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count > 1 Then Exit Sub
   If Not Intersect(Target, [AW4]) Is Nothing Then
      Dim r As Range, c As Range
         Set r = Columns(1).Find([AW2])
         Set c = Rows(1).Find([AW3])
          Cells(r.Row, c.Column) = [AW4]
   End If
End Sub

Изменено: Mershik - 14 янв 2021 22:23:23
Не бойтесь совершенства. Вам его не достичь.
Пронумеровать список с разделителем ";" (точка с запятой)
 
New, а фиг его знает ) что-то в процессе думал удалил, а кусок остался))
Код
Sub mrshkei()
Dim arr, i As Long, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
    arr = Split(Cells(i, 1), ";")
    For n = LBound(arr) To UBound(arr)
        t = t & " " & n + 1 & ". " & arr(n)
    Next n
    Cells(i, 2) = t & ".": t = Empty
Next i
End Sub
Не бойтесь совершенства. Вам его не достичь.
Пронумеровать список с разделителем ";" (точка с запятой)
 
Код
Sub mrshkei()
Dim arr, i As Long, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
    arr = Split(Cells(i, 1), ";")
    For n = LBound(arr) To UBound(arr)
    x = UBound(arr) + 1
        t = t & " " & n + 1 & ". " & arr(n)
    Next n
    Cells(i, 2) = t & "."
    t = Empty
Next i
End Sub
Изменено: Mershik - 14 янв 2021 20:01:15
Не бойтесь совершенства. Вам его не достичь.
Поиск совпадений из массива в списке и подстановка соответствующих значений из массива
 
g-flex, зачем два столбца с названием "номер"?
Код
=ЕСЛИОШИБКА(ПРОСМОТР(2;1/ПОИСК($H$2:$H$6;B2);$I$2:$I$6);"")
Изменено: Mershik - 14 янв 2021 19:58:12
Не бойтесь совершенства. Вам его не достичь.
Пронумеровать список с разделителем ";" (точка с запятой)
 
diman116, вариант макросом
Код
Sub mrshkei()
Dim arr, i As Long, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
    arr = Split(Cells(i, 1), ";")
    For n = LBound(arr) To UBound(arr)
    x = UBound(arr) + 1
        t = t & " " & n + 1 & ". " & arr(n)
    Next n
    Cells(i, 2) = t
    t = Empty
Next i
End Sub
Не бойтесь совершенства. Вам его не достичь.
Перенос в ячейку значения из диалогового окна
 
Swoop,
Код
Sub mrshkei()
Dim  arr
arr = Range("A2:A15")
For i = LBound(arr) To UBound(arr)
    x = Application.InputBox(arr(i, 1), Type:=2)
    lr = Cells(Rows.Count, 2).End(xlUp).Row + 1
    Cells(lr, 2) = x
Next i
End Sub
Изменено: Mershik - 14 янв 2021 17:39:52
Не бойтесь совершенства. Вам его не достичь.
Привязка комментария к строке в таблице по запросу, вопрос
 
Дмитрий Рыбин, в PQ не знаю смогут ли помочь, а вариант обновлять запрос может через макрос и перед обновлением создавать лист дубликат, потом обновлять данные  и после проходить  проходить по каждому значению листа дубликата и искать "Обозначение" - если оно найдено в новом запросе перемещать в него старый
"Статус ОМТС"... обозначения же не повторяются как я понял
Изменено: Mershik - 14 янв 2021 16:19:03
Не бойтесь совершенства. Вам его не достичь.
Привязка комментария к строке в таблице по запросу, вопрос
 
Дмитрий Рыбин, покажите файл-пример с исходными данными и желаемым результатом
Не бойтесь совершенства. Вам его не достичь.
Отображение времени последнего изменения в ячейке
 
Цитата
Tokhtamysh написал:
ак-то формулами это можно обойти?  
нет
Изменено: Mershik - 14 янв 2021 12:36:09
Не бойтесь совершенства. Вам его не достичь.
Создать в календаре правило соответствующее номеру заказа и фамилии инженера + всплывающее окно отображения ответственного
 
Цитата
Mershik написал:
Range("E6:AI11")
это диапазон действия макроса - задайте нужный
Изменено: Mershik - 14 янв 2021 12:40:25
Не бойтесь совершенства. Вам его не достичь.
Редактирование макроса в книге другим макросом
 
Цитата
Jack Famous написал:
можно давать ссылку сразу на конкретный пост, кликнув по #
а я и не знал) спасибо.
Не бойтесь совершенства. Вам его не достичь.
Повтор каждой 8-й ячейки по 8 раз начиная с 5-й строки
 
Виктор Иванов, я не предлагал вам формулу...если хотите формулой то так кка у вас все данные одинаковой стркутуры, то для первой таблицы
в ячейку M4
Код
=I5
в ячейку М5 и протянуть до М11
Код
=M4
затем выделяете диапазон М4:М11 и тяните за правый нижний уголок вниз.

ну и код :
Код
Sub mrshkei()
Dim i As Long, lr As Long
lr = Cells(Rows.Count, 9).End(xlUp).Row
For i = 5 To lr Step 8
    Range(Cells(i - 1, 15), Cells(i + 6, 15)) = Cells(i, 9)
Next
End Sub
Изменено: Mershik - 14 янв 2021 12:04:45
Не бойтесь совершенства. Вам его не достичь.
Повтор каждой 8-й ячейки по 8 раз начиная с 5-й строки
 
Виктор Иванов,
Код
Sub mrshkei()
Dim i As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To lr Step 8
    Cells(i, 1).Copy Destination:=Range(Cells(i + 1, 1), Cells(i + 7, 1))
Next
End Sub
Не бойтесь совершенства. Вам его не достичь.
Создать в календаре правило соответствующее номеру заказа и фамилии инженера + всплывающее окно отображения ответственного
 
aniramulis,  как вариант так - присвоить на листе заказчик каждому инженеру цвет (заливкой).
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target = Empty Then Exit Sub
If Not Intersect(Target, Range("E6:AI11")) Is Nothing Then
Dim cell As Range, sh As Worksheet
Set sh = Worksheets("Заказчик")
Set cell = sh.Columns(1).Find(Target, LookIn:=xlValues, LookAt:=xlWhole)
If Not cell Is Nothing Then
    Cells(Target.Row, Target.Column).Interior.ColorIndex = cell.Offset(0, 4).Interior.ColorIndex
    If (Cells(Target.Row, Target.Column).Comment Is Nothing) Then
        Cells(Target.Row, Target.Column).AddComment.Text "Менеджер:" & Chr(10) & cell.Offset(0, 2)
    Else
        Cells(Target.Row, Target.Column).Comment.Text "Менеджер:" & Chr(10) & cell.Offset(0, 2)
    End If
Else
    MsgBox "УКАЗАННЫЙ ПРОЕКТ НЕ НАЙДЕН"
End If
End If
End Sub
Изменено: Mershik - 14 янв 2021 09:52:31
Не бойтесь совершенства. Вам его не достичь.
Создать в календаре правило соответствующее номеру заказа и фамилии инженера + всплывающее окно отображения ответственного
 
aniramulis, не очень понял...ну может так (вносит номера проектов на листе исполнит.)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target = Empty Then Exit Sub
If Not Intersect(Target, Range("E6:AI11")) Is Nothing Then
Dim cell As Range, sh As Worksheet
Set sh = Worksheets("Заказчик")
Set cell = sh.Columns(1).Find(Target, LookIn:=xlValues, LookAt:=xlWhole)
If Not cell Is Nothing Then
    Cells(Target.Row, Target.Column).Interior.ColorIndex = cell.Row - 1
    If (Cells(Target.Row, Target.Column).Comment Is Nothing) Then
        Cells(Target.Row, Target.Column).AddComment.Text "Менеджер:" & Chr(10) & cell.Offset(0, 2)
    Else
        Cells(Target.Row, Target.Column).Comment.Text "Менеджер:" & Chr(10) & cell.Offset(0, 2)
    End If
    
Else
    MsgBox "УКАЗАННЫЙ ПРОЕКТ НЕ НАЙДЕН"
End If
End If
End Sub

Не бойтесь совершенства. Вам его не достичь.
Создать в календаре правило соответствующее номеру заказа и фамилии инженера + всплывающее окно отображения ответственного
 
Цитата
aniramulis написал:
Закладка №1
что такое закладка?
Цитата
aniramulis написал:
Есть менеджер, который ищет клиентов и заключает контрактыЕсть инженер, который все это переводит в смету и далее передает исполнителямОни присваивают номер для полученного заказа - "Проекта"
ни менеджера, ни инженера ровным счетом ничего у нас нет (это только у вас)

пы.сы. нужен файл-пример с исходными данным и показанным отдельно желаемым результатом *ручками  сделать
а еще забыл - название темы общее не отражает сути(конкретики) - модераторы скорее всего ее удалят или как минимум скрою помощь,  (предложите в тексте новое а модераторы заменят)
Изменено: Mershik - 13 янв 2021 21:43:57
Не бойтесь совершенства. Вам его не достичь.
Зная дату и фамилию, записать значение в ячейку пересечения этих двух параметров
 
Элона Шеверенко, макрос вам в помощь)
а без файла с исходными данными и показанным желаемым результатом маловероятно кто поможет)
Не бойтесь совершенства. Вам его не достичь.
Поиск в ячейке и на основании нескольких вхождений подставление шифра
 
ferit, что нет? я спросил ЧТО в приведенном является желаемым результатом?
Не бойтесь совершенства. Вам его не достичь.
Поиск в ячейке и на основании нескольких вхождений подставление шифра
 
ferit,  что в последнем файле желаемый результат?
Не бойтесь совершенства. Вам его не достичь.
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 217 След.
Наверх