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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 130 След.
Замена значений выпадающего списка, Вставить в ячейку значения отличные от выпадающего списка
 
Алексей Чуйкин, в модуль листа
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A2:i20")) Is Nothing Then
Set myfind = Worksheets("Лист2").Columns(2).Find(Target.Value, LookIn:=xlValues)
On Error Resume Next
Range(Target.Address) = myfind.Offset(0, -1)
End If
End Sub
Замена значений выпадающего списка, Вставить в ячейку значения отличные от выпадающего списка
 
Алексей Чуйкин, т.е. выбирая из выпадающего списка цвет вы хотите просто закрашивать ее. но при это что бы ячейка оставалась пустой??
Автозаполнение нумерации до конца смежного столбца
 
stsergey, ничего не понятно, опишите нормально вашу задачу... и покажите в файле что есть и сто должно получиться ! две так сказать таблички
так?
Код
Sub numerciya()
Dim i As Double
Application.ScreenUpdating = False
LR2 = Cells(Rows.Count, 3).End(xlUp).Row
    For i = 2 To LR2
        Cells(i, 2) = "п." & i - 1
        If Cells(i, 1) = "" Then
        Cells(i, 1) = Cells(i - 1, 1)
        End If
    Next i
Application.ScreenUpdating = True
End Sub

Изменено: Mershik - 5 Апр 2020 09:57:25
Сцепить режим работы офисов продаж из множества колонок по формату
 
Nemeadia, тут ищите обратите внимание на 2.2, 2.3, 2.4
Автозаполнение нумерации до конца смежного столбца
 
stsergey, так7
Код
Sub Num()
  Range("B1").Select
    Dim iLastRow2 As Long
   Application.ScreenUpdating = False
    iLastRow2 = Cells(Rows.Count, 2).End(xlUp).Row
    Cells(iLastRow2 + 1, 2).Select
     Application.ScreenUpdating = True
    ActiveCell.FormulaR1C1 = "i1"
     Dim iLastRow1 As Long
   Application.ScreenUpdating = False
       iLastRow1 = Cells(Rows.Count, 3).End(xlUp).Row
       Cells(iLastRow1 + 1, 3).Select
Range("B" & iLastRow2 - 1 & ":B" & iLastRow2).AutoFill Destination:=Range("B" & iLastRow2 - 1 & ":B" & iLastRow1)
End Sub
Изменено: Mershik - 4 Апр 2020 20:19:47
VBA Определить площадь части прямоугольника в первой четверти
 
Axbanet, кажется даже название похоже... https://www.cyberforum.ru/pascal/thread271481.html
Изменено: Mershik - 4 Апр 2020 18:48:58
Отбор уникальных значений в динамическом массиве (новая запись добавляется вверху массива)
 
ms041270, Вариант сводной таблицей (лист3) и макросом (Лист2)..
Код
Sub unik()
Dim i As Double
Worksheets("Ëèñò2").Range("A:B").ClearContents
LR = Worksheets("Ëèñò1").Cells(Rows.Count, 2).End(xlUp).Row
    For i = 2 To LR
    k = Application.WorksheetFunction.CountIf(Worksheets("Ëèñò2").Range("A:A"), Worksheets("Ëèñò1").Range("B" & i))
    If k < 1 Then
    LR2 = Worksheets("Ëèñò2").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Worksheets("Ëèñò2").Cells(LR2, 1) = Worksheets("Ëèñò1").Cells(i, 2)
    Max = Application.WorksheetFunction.MaxIfs(Worksheets("Ëèñò1").Range("E:E"), Worksheets("Ëèñò1").Range("B:B"), Worksheets("Ëèñò1").Cells(i, 2))
    Worksheets("Ëèñò2").Cells(LR2, 2) = Max
    End If
    Next i
End Sub
Изменено: Mershik - 4 Апр 2020 17:37:06
Получение n количества дат, при вводе количества дней
 
Harin11,  вечер добрый.
Код
=ЕСЛИОШИБКА(ЕСЛИ(G3+1>$K$3+$K$5-1;"";G3+1);"")

или макросом смотрите файл2

Код
Sub dati()
Dim i As Double
Range("G3:G" & Cells(Rows.Count, 7).End(xlUp).Row).ClearContents
For i = 4 To 4 + Cells(5, 11)
    Cells(3, 7) = Cells(3, 11)
    If Cells(i - 1, 7) + 1 <= Cells(3, 11) + Cells(5, 11) - 1 Then
    Cells(i, 7) = Cells(i - 1, 7) + 1
    Else
    Exit For
    End If
Next i
End Sub

Изменено: Mershik - 3 Апр 2020 17:34:40
Цикл. Переход к следующему условию, если предыдущее не было выполнено
 
Nasty621,
Цитата
Nasty621 написал:
Нужно выйти из цикла For если не выполняется условие
а вообще нужен файл-пример с тем что есть и то что хотите получить
Код
перед циклом 
If условие then 
заходим в цикл
for to step
next
else
If условие then 
следующее условие
Изменено: Mershik - 3 Апр 2020 17:16:42
Ошибка #знач! При использовании функции склонения (Надстройка vba-exel), Исправление ошибки с целью корректного перевода фио из именительный в родительный падеж
 
Андрей-1821, думаю на оплату)
Автоматическое заполнение столбца массивом значение с поочередным инвертированием значений
 
deemegge, удачи в решении вопроса) так как я не понимаю ЧТО НУЖНО ДЕЛАТЬ) думаю кто-то поймет
Автоматическое заполнение столбца массивом значение с поочередным инвертированием значений
 
deemegge,какую формулу? я вас спросил
Цитата
Mershik написал:
а логика есть?
я не просил вас формулу составлять же...просто объясните что нужно сделать словами
Изменено: Mershik - 2 Апр 2020 13:10:59
Автоматическое заполнение столбца массивом значение с поочередным инвертированием значений
 
deemegge,  а логика есть? почему так, а не иначе?
Цитата
deemegge написал:
Автоматическое заполнение столбца
возможно только макросом, а есл формулой то растянуть ее на заведомо больший диапазон...так как формула не умеет определять
Цитата
deemegge написал:
последней активной строки
VBA цикл удаления строк умной таблицы удаляет только половину строк
 
Oleg_BB, Oleg_BB, скорее всего R Dmitry, имеет ввиду что цикл нужно запустить в обратном порядке:
знаю как обычно это цклом FOr
Код
For  i=последняя_строка to первая_строка step -1

next i
Изменено: Mershik - 1 Апр 2020 22:40:13
VBA цикл удаления строк умной таблицы удаляет только половину строк
 
Oleg_BB, файл-пример с данными покажите....
Поиск в столбце ячейки с наибольшим количеством символов.
 
Norton Virt, вечер в... ой добрый)
так? МАССИВНАЯ
Код
=НАИБОЛЬШИЙ(ДЛСТР(A4:A8);1)
Сумма не повторяющихся сотрудников со статусами (в зависимости от фильтра)
 
uva, про фильтр не понял что-то...
как понял, с доп. столбцом для
Цитата
uva написал:
количество не повторяющихся ФИО со статусом где ячейка статуса не равна МВ или пустой ячейки
Код
=СУММПРОИЗВ((($E$7:$E$138<>"-")*($E$7:$E$138<>"МВ"))/СЧЁТЕСЛИМН($E$7:$E$138;$E$7:$E$138;$
Изменено: Mershik - 1 Апр 2020 16:32:50
Вывод цены по приоритетности по заданным данным
 
Diana1302, в примере покажите, а так как понял....
Код
=ЕСЛИОШИБКА(ИНДЕКС(B6:E6;1;ПОИСКПОЗ(ЛОЖЬ;ИНДЕКС(ЕПУСТО(B6:E6);1;0);0))*ЕСЛИ(ИНДЕКС(B6:E6;1;ПОИСКПОЗ(ЛОЖЬ;ИНДЕКС(ЕПУСТО(B6:E6);1;0);0))=D6;0,97;ЕСЛИ(ИНДЕКС(B6:E6;1;ПОИСКПОЗ(ЛОЖЬ;ИНДЕКС(ЕПУСТО(B6:E6);1;0);0))=E6;1,03;1));"ДАННЫХ НЕТ")
Изменено: Mershik - 1 Апр 2020 16:21:59
Удаление пустых ячеек с условием
 
Sharmat, так как
Цитата
Sharmat написал:
Строк товара тысячи
объясните по порядку как  что перемещать и что удалять...т.е. берем то ставим туда + прибавляем это, остальное удаляем...
у Вас получается если нет кол-ва нужно удалить?!
сделал как понял
Код
Sub dsd()
Dim i As Double
Dim n As Double
Worksheets("Нужно").Range("A2", ActiveCell.SpecialCells(xlLastCell)).ClearContents
Application.ScreenUpdating = False

    For i = 2 To Worksheets("Дано").Cells(Rows.Count, 1).End(xlUp).Row
        ilastrow = Worksheets("Нужно").Cells(Rows.Count, 1).End(xlUp).Row + 1
        For n = 3 To Worksheets("Дано").Cells(i, Columns.Count).End(xlUp).Column Step 3
        If Worksheets("Дано").Cells(i, n) <> "" Then
        ilastcol = Worksheets("Нужно").Cells(ilastrow, Columns.Count).End(xlToLeft).Column + 1
        Worksheets("Нужно").Cells(ilastrow, 1) = Worksheets("Дано").Cells(i, 1)
        Worksheets("Нужно").Cells(ilastrow, ilastcol) = Worksheets("Дано").Cells(i, n - 1)
        Worksheets("Нужно").Cells(ilastrow, ilastcol + 1) = Worksheets("Дано").Cells(i, n)
        Worksheets("Нужно").Cells(ilastrow, ilastcol + 2) = Worksheets("Дано").Cells(i, n + 1)
        End If
        Next n
    Next i
    
Application.ScreenUpdating = True
End Sub
Изменено: Mershik - 1 Апр 2020 15:11:44
Вытащить из адреса отдельно улицу, № дома и номер квартиры.
 
IamDubstpper, Тема: Вытащить из адреса отдельно улицу, № дома и номер квартиры.

Есть подозрения, что у Вас вряд ли так все адреса написаны...но что показали то показали.
Изменено: Mershik - 1 Апр 2020 14:37:51
Вытащить из адреса отдельно улицу, № дома и номер квартиры.
 
IamDubstpper, Добрый день,  Ваше "например" может оказаться иным по факту решения задачи..
советую вам приложить файл-пример где показать исходные донные и желаемый результат.

Покажите максимально разные варианты написания адрес (10-20 строк).
Использование функции из надстройки PLEX в коде
 
kalle, может у вас просто отключен автоматический перерасчет формул?  
Как перевести функцию СРЗНАЧЕСЛИМН в Макрос?, Макрос функции СРЗНАЧЕСЛИМН при 3 критериях
 
Халил, WorksheetFunction.AverageIfs - это разве не
Цитата
Халил написал:
Как перевести функцию СРЗНАЧЕСЛИМН в Макрос?,
а можно просто на словах что нужно, как нужно и куда, а не что бы сидеть и разбирать ваш макрос
Изменено: Mershik - 1 Апр 2020 12:43:38
Данные в сводной таблице из строк в столбцы
 
occupiedwork, вы я так полагаю обращаетесь к БМВ,....но посмотрите еще вариант в PQ
Макрос для ввода значения в зависимости от даты другой ячейки
 
Kent_ok,
Цитата
Kent_ok написал:
переместил в другой диапазон
Цитата
Kent_ok написал:
не работает
оно и работает.. замените 1 на 12 в вашем случае, а 2 на 13 соответственно что бы рядом выводились "1"
Код
Sub data_1()Dim i As Double
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row ' 1 - это номер столбца в котором проверяем дату с сегодня
        If Cells(i, 1) = Date Then Cells(i, 2) = 1 ' 1 то же самое - 2 это номер столбца куда ставить единицу если дата=сегодня()
    Next i
End Sub
Изменено: Mershik - 1 Апр 2020 11:51:53
Извлечь фрагмент между третьей и четвертой запятой
 
OLGA852,
Код
=ПСТР(A1;НАЙТИ(СИМВОЛ(1);ПОДСТАВИТЬ(A1;",";СИМВОЛ(1);3))+1;НАЙТИ(СИМВОЛ(1);ПОДСТАВИТЬ(A1;",";СИМВОЛ(1);4))-(НАЙТИ(СИМВОЛ(1);ПОДСТАВИТЬ(A1;",";СИМВОЛ(1);3))+1))
Макрос для ввода значения в зависимости от даты другой ячейки
 
Kent_ok, пожалуйста)
Макрос для ввода значения в зависимости от даты другой ячейки
 
Kent_ok,именно макросом?
Код
Sub data_1()
Dim i As Double
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1) = Date Then Cells(i, 2) = 1
    Next i
End Sub
Изменено: Mershik - 1 Апр 2020 10:49:10
Вывод цены по приоритетности по заданным данным
 
Diana1302,  вариант:
Код
=ЕСЛИОШИБКА(ИНДЕКС(B4:E4;1;ПОИСКПОЗ(ЛОЖЬ;ИНДЕКС(ЕПУСТО(B4:E4);1;0);0));"ДАННЫХ НЕТ")
Вставить в формулу текст из ячейки = имя файла
 
Двссыл на большом количестве моет тормозить, но все это нужно проверять в работе.
для макроса нужно понимание, что вы делаете дял чего ссылка на название книги, какие таблицы, а так
If nothing then должно помочь
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 130 След.
Наверх