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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 217 След.
Макрос который заменяет сводную таблицу на простую таблицу с сохранением формата ячеек
 
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,  что в последнем файле желаемый результат?
Не бойтесь совершенства. Вам его не достичь.
CSV > 1 млн строк - как макросом обработать
 
Сергей, вы бы хоть описались в прошлой теме там вроде Вам помогли....
а тут я не уверен лучше не макросом...или может кусками как-то...
Не бойтесь совершенства. Вам его не достичь.
Как в Автофильтре отделить текстовое вхождение в строке "#1" от "#10", если после "#1" может быть как конец строки, так и любой символ
 
Barmaldon, yне понятно что вы там приложили, ну может макрсоы отключены
Не бойтесь совершенства. Вам его не достичь.
Как в Автофильтре отделить текстовое вхождение в строке "#1" от "#10", если после "#1" может быть как конец строки, так и любой символ
 
Barmaldon, макрос
Код
Sub mrshkei()
Dim i As Long, lr As Long, arr As Variant, arr2, arr3
ReDim arr2(1 To 1)
arr = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr3 = Range("A2:A" & lr)
xxx = "#1"
For i = LBound(arr3) To UBound(arr3)
    n = InStr(arr3(i, 1), xxx)
    If n > 0 Then
        For k = LBound(arr) To UBound(arr)
            If Mid(arr3(i, 1), n + Len(xxx), 1) = arr(k) Then
                Exit For
            Else
                x = x + 1
            End If
        Next k
        If x = 10 Then
            arr2(UBound(arr2)) = arr3(i, 1)
            ReDim Preserve arr2(1 To UBound(arr2) + 1)
        End If
        x = 0
    End If
Next i
Range("C2:C" & lr).Clear
Range("C2").Resize(UBound(arr2), 1) = Application.WorksheetFunction.Transpose(arr2)
End Sub



Изменено: Mershik - 12 янв 2021 16:37:56
Не бойтесь совершенства. Вам его не достичь.
Консолидация данных, Из двух таблиц сделать одну
 
Антон Сергеев, с таким названием тему удалят или помощь вы не увидите потому что ее скроют пока вы норм название не ПРЕДЛОЖИТЕ (заменят модераторы)
Изменено: Mershik - 12 янв 2021 12:32:27
Не бойтесь совершенства. Вам его не достичь.
При создании ссылки на данные в сводной таблице слетает значение
 
Екатерина Е, нужер пример в котором показать 1 - исходные данные 2- желаемый результат (ручками вбейте пар строк)
Не бойтесь совершенства. Вам его не достичь.
Выписать в соответствующие ряды значения из таблицы исключая пустые ячейки
 
Сергей, что-то не понтяное - может таак
Код
=ЕСЛИОШИБКА(ИНДЕКС($B2:$F2;1;АГРЕГАТ(15;6;СТОЛБЕЦ($A$2:$F$2)/($B2:$F2<>"")/($B2:$F2<>"н");СТОЛБЕЦ(A$1)));"")
Не бойтесь совершенства. Вам его не достичь.
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 217 След.
Наверх