Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » МатросНаЗебре
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 281 След.
Определения 4 чисел, из заданного диапазона, с определённым условиями, Помогите пожалуйста
 
#
27.06.2025 15:53:21
Создание макросов и пользовательских функций на VBA
Способ 1. Создание макросов в редакторе Visual Basic
 
Перейти    
[ Закрыто] Нужно разработать алгоритм ротации товаров между торговыми точками для оптимизации закупок и оборачиваемости товаров
 
#
27.06.2025 14:36:43
Цитата
написал:
ЗП_кандидат As Integer
Тонкая ирония, что больше 32768 он не получит.  :D
А ему ещё тут платить!
 
Перейти    
Как обновить форму при выборе из ComboBox
 
#
27.06.2025 14:34:29
Цитата
написал:
Что-то я вообще не понял, какая форма и как она должна перезагрузится?
Тоже было недопонимание.
Какой заяц! Какая блоха!

Предполагаю, что на форум выложен вариант, из которого исключили работу с другими формами. Потом разумеется возник закономерный вопрос "а почему другие формы не работают?" Тут уже возник встречный вопрос "какие формы?".
 
Перейти    
Как обновить форму при выборе из ComboBox
 
#
27.06.2025 14:06:28
Код
Option Explicit
Option Base 1
 
Private disableEvents As Boolean
 
Private Sub CommandButton42_Click()
ComboBox31.Value = Empty
Sheets("Данные").Range("G5").Value = Empty
End Sub
 
 
Private Sub UserForm_Initialize()
 

Dim s&
 
ComboBox31.MatchEntry = fmMatchEntryNone
 
With Sheets("Нор_Док_МРК") ' с какого листа построение списка
 
s = .Cells(Rows.Count, 18).End(xlUp).Row ' с какой строки построения списка
ComboBox31.List = myDate(.Range(.Cells(3, 18), .Cells(s, 18)).Value) '.Range(.Cells(с какой строки, с какого столбца), .Cells(s, с какого столбца)).Value
If disableEvents = False Then
    disableEvents = True
    Me.ComboBox31 = ['Данные'!G5] ' куда сделать запись при выборе
    disableEvents = False
End If
End With
 
End Sub
 
Private Function myDate(arr As Variant) As Variant
    Dim ya As Long
    For ya = 1 To UBound(arr, 1)
        If IsDate(arr(ya, 1)) Then arr(ya, 1) = Format(arr(ya, 1), "DD.MM.YYYY")
    Next
    myDate = arr
End Function
 
'Список № 31 !!!!! Откуда и куда делать запись
 
'Private Sub ComboBox31_Click()
'Sheets("Данные").Range("G5") = ComboBox31.Value 'сделать запись в ячейку
'End Sub
'
Private Sub ComboBox31_Change()
    Sheets("Данные").Range("G5") = ComboBox31.Value
    If disableEvents Then Exit Sub
    ComboBox31.DropDown
    disableEvents = True
    UserForm_Initialize
    disableEvents = False
End Sub
 
Private Sub ComboBox31_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim n&, b&
Dim txt$
Dim Spisok(), NewSpisok()
 
If KeyCode <> 38 And KeyCode <> 40 And KeyCode <> 13 Then
    With Sheets("Нор_Док_МРК") 'с какого листа построение списка
        n = .Cells(Rows.Count, 18).End(xlUp).Row ' с какой строки построения списка
        Spisok = .Range(.Cells(3, 18), .Cells(n, 18)).Value '.Range(.Cells(с какой строки, с какого столбца), .Cells(n, с какого столбца)).Value
    End With
     
    b = 0
    txt = ComboBox31.Text
    If txt = "" Then ComboBox31.List = Spisok: Exit Sub
     
    ComboBox31.Clear
    Erase NewSpisok
     
    For n = 1 To UBound(Spisok)
        If InStr(1, Spisok(n, 1), txt, vbTextCompare) Then
            b = b + 1
            ReDim Preserve NewSpisok(b)
            NewSpisok(b) = Spisok(n, 1)
        End If
    Next n
     
    If b <> 0 Then ComboBox31.List = NewSpisok
End If
End Sub
 
Перейти    
Как обновить форму при выборе из ComboBox
 
#
27.06.2025 13:49:06
Цитата
написал:
только форма не перезагружается
Ааа...., судя по всему, эта фраза должна звучать "только другая форма не перегружается".
 
Перейти    
Как обновить форму при выборе из ComboBox
 
#
27.06.2025 13:25:48
А вам точно отдельная форма нужна?
В Excel есть штатное средство.
ДАННЫЕ-Проверка данных-Проверка данных-Тип данных: Список-Источник:
Код
=СМЕЩ(Нор_Док_МРК!R3;0;0;СЧЁТЗ(Нор_Док_МРК!R:R);1)
 
Перейти    
Как обновить форму при выборе из ComboBox
 
#
27.06.2025 13:19:12
Цитата
написал:
не перезагружается при выборе из "ComboBox, куда дописать это?:
Это две разных проблемы?
 
Перейти    
[ Закрыто] Нужно разработать алгоритм ротации товаров между торговыми точками для оптимизации закупок и оборачиваемости товаров
 
#
27.06.2025 13:08:33
Цитата
Msi2102 написал:
Интересно, а это тестовое задание при приеме на работу?
В принципе, будет неплохо, если кандидата возьмут, а он из-за нехватки знаний будет размещать задачи в платной ветке.
Всем хорошо. Работник - работает, работодатель - получает решения своих задач, мы - кодим. :D
 
Перейти    
Как обновить форму при выборе из ComboBox
 
#
27.06.2025 13:03:07
А так?
Скрытый текст
 
Перейти    
[ Закрыто] Нужно разработать алгоритм ротации товаров между торговыми точками для оптимизации закупок и оборачиваемости товаров
 
#
27.06.2025 12:43:08
А оно там есть :D  
 
Перейти    
Как обновить форму при выборе из ComboBox
 
#
27.06.2025 12:41:56
Код
Option Explicit
Option Base 1

Private Sub CommandButton42_Click()
ComboBox31.Value = Empty
Sheets("Данные").Range("G5").Value = Empty
End Sub


Private Sub UserForm_Initialize()
Dim s&

ComboBox31.MatchEntry = fmMatchEntryNone

With Sheets("Нор_Док_МРК") ' с какого листа построение списка

s = .Cells(Rows.Count, 18).End(xlUp).Row ' с какой строки построения списка
ComboBox31.List = myDate(.Range(.Cells(3, 18), .Cells(s, 18)).Value) '.Range(.Cells(с какой строки, с какого столбца), .Cells(s, с какого столбца)).Value
Me.ComboBox31 = ['Данные'!G5] ' куда сделать запись при выборе
   
End With

End Sub

Private Function myDate(arr As Variant) As Variant
    Dim ya As Long
    For ya = 1 To UBound(arr, 1)
        If IsDate(arr(ya, 1)) Then arr(ya, 1) = Format(arr(ya, 1), "DD.MM.YYYY")
    Next
    myDate = arr
End Function

'Список № 31 !!!!! Откуда и куда делать запись

Private Sub ComboBox31_Click()
Sheets("Данные").Range("G5") = ComboBox31.Value 'сделать запись в ячейку
End Sub

Private Sub ComboBox31_Change()
ComboBox31.DropDown
UserForm_Initialize
End Sub

Private Sub ComboBox31_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim n&, b&
Dim txt$
Dim Spisok(), NewSpisok()

If KeyCode <> 38 And KeyCode <> 40 And KeyCode <> 13 Then
    With Sheets("Нор_Док_МРК") 'с какого листа построение списка
        n = .Cells(Rows.Count, 18).End(xlUp).Row ' с какой строки построения списка
        Spisok = .Range(.Cells(3, 18), .Cells(n, 18)).Value '.Range(.Cells(с какой строки, с какого столбца), .Cells(n, с какого столбца)).Value
    End With
    
    b = 0
    txt = ComboBox31.Text
    If txt = "" Then ComboBox31.List = Spisok: Exit Sub
    
    ComboBox31.Clear
    Erase NewSpisok
    
    For n = 1 To UBound(Spisok)
        If InStr(1, Spisok(n, 1), txt, vbTextCompare) Then
            b = b + 1
            ReDim Preserve NewSpisok(b)
            NewSpisok(b) = Spisok(n, 1)
        End If
    Next n
    
    If b <> 0 Then ComboBox31.List = NewSpisok
End If
End Sub
 
Перейти    
Выделить столбцы в умной таблице
 
#
26.06.2025 17:50:38
Для несвязанных диапазонов.
Код
Option Explicit

Sub Выделить_ниже_активных()
    Dim cl As Range, ru As Range
    For Each cl In Intersect(Selection, ActiveSheet.UsedRange).Cells
        Set ru = myUnion(GetBottom(cl), ru)
    Next
    If Not ru Is Nothing Then ru.Select
End Sub
 
Private Function myUnion(rr As Range, ru As Range) As Range
    If rr Is Nothing Then
        Set myUnion = ru
    ElseIf ru Is Nothing Then
        Set myUnion = rr
    Else
        Set myUnion = Union(rr, ru)
    End If
End Function

Private Function GetBottom(cl As Range) As Range
    On Error Resume Next
    Dim rr As Range
    Set rr = cl
    Set rr = cl.Areas(1)
    Set rr = rr.Offset(1)
    Set rr = rr.Resize(rr.ListObject.DataBodyRange.Rows.Count)
    Set rr = Intersect(rr, rr.ListObject.DataBodyRange)
    Set GetBottom = rr
    On Error GoTo 0
End Function
 
Перейти    
Выделить столбцы в умной таблице
 
#
26.06.2025 17:44:26
Цитата
написал:
ниже выделенных ячеек
Для непрерывных диапазонов.
Код
Option Explicit

Sub Выделить_ниже_активной()
    GetBottom(Selection).Select
End Sub
 
Sub Значения_ниже_активной()
    With GetBottom(Selection)
        .Value = .Value
    End With
End Sub
 
Private Function GetBottom(cl As Range) As Range
    On Error Resume Next
    Dim rr As Range
    Set rr = cl
    Set rr = cl.Areas(1)
    Set rr = rr.Offset(1)
    Set rr = rr.Resize(rr.ListObject.DataBodyRange.Rows.Count)
    Set rr = Intersect(rr, rr.ListObject.DataBodyRange)
    Set GetBottom = rr
    On Error GoTo 0
End Function
 
Перейти    
Выделить столбцы в умной таблице
 
#
26.06.2025 16:45:56
Выглядит всё-таки, что выделение это промежуточный этап. Вот вам макросы и выделяющие, и заменяющие формулы на значения.
Код
Sub Выделить_ниже_активной()
    GetBottom.Select
End Sub

Sub Значения_ниже_активной()
    With GetBottom
        .Value = .Value
    End With
End Sub

Private Function GetBottom() As Range
    On Error Resume Next
    Dim rr As Range
    Set rr = ActiveCell
    Set rr = rr.Cells(2, 1)
    Set rr = rr.Resize(rr.ListObject.DataBodyRange.Rows.Count)
    Set rr = Intersect(rr, rr.ListObject.DataBodyRange)
    Set GetBottom = rr
    On Error GoTo 0
End Function
 
Перейти    
Выделить столбцы в умной таблице
 
#
26.06.2025 16:35:16
Цитата
написал:
но захватывает активную
Код
Sub Выделить_ниже_активной()
    On Error Resume Next
    
    Dim rr As Range
    Set rr = ActiveCell
    Set rr = rr.Cells(2, 1)
    Set rr = rr.Resize(rr.ListObject.DataBodyRange.Rows.Count)
    Set rr = Intersect(rr, rr.ListObject.DataBodyRange)
    rr.Select
    
    On Error GoTo 0
End Sub
 
Перейти    
Выделить столбцы в умной таблице
 
#
26.06.2025 16:28:57
Код
Sub Выделить_ниже_активной()
    On Error Resume Next
    
    Dim rr As Range
    Set rr = ActiveCell
    Set rr = rr.Resize(rr.ListObject.DataBodyRange.Rows.Count)
    Set rr = Intersect(rr, rr.ListObject.DataBodyRange)
    rr.Select
    
    On Error GoTo 0
End Sub
 
Перейти    
Макрос скрытие пустых строк при изменении ячейки
 
#
26.06.2025 12:31:37
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
    If Target.Address(0, 0, xlA1) = "M5" Then
       Dim xRg As Range
       Application.ScreenUpdating = False
           For Each xRg In Range("FJ38:FJ67")
               If xRg.Value = "" Then
                   xRg.EntireRow.Hidden = True
           
               Else
                   xRg.EntireRow.Hidden = False
               End If
           Next xRg
       Application.ScreenUpdating = True
    End If
End Sub
Если изменятся фамилия в ячейке M5, то скрываются или отображаются строки 38:67, в зависимости от значений в FJ38:FJ67.
 
Перейти    
Определения 4 чисел, из заданного диапазона, с определённым условиями, Помогите пожалуйста
 
#
26.06.2025 08:48:16
А, это нормально  :D  
 
Перейти    
Счет ячеек в одной строке, Нужно посчитать количества заполненных ячеек, при этом если ячейки заполнены подряд, то считать их как одну ячейку
 
#
25.06.2025 14:14:17
Код
=СЧЁТЕСЛИМН(B3:H3;"ТО*";A3:G3;"<>ТО*")
 
Перейти    
Определения 4 чисел, из заданного диапазона, с определённым условиями, Помогите пожалуйста
 
#
25.06.2025 13:40:00
Ошибку с кириллицей можно убрать, если перед копированием кода с форума переключить раскладку на русскую.
Цитата
написал:
попытался запустить макрос, но не понял как сам он работает
Проблема в том, что макрос не работает, или в том, что не поняли, как он работает?
 
Перейти    
Создание единой таблицы, Макрос
 
#
25.06.2025 11:57:17
Попросил в личку пример файла.
Сделал, оплату получил.
Изменено: МатросНаЗебре - 25.06.2025 13:41:03
 
Перейти    
Формула, учитывающая несколько условий, Нужна помощь в корректировке формулы
 
#
25.06.2025 09:56:18
Ну, допустим, так.
Код
=ЕСЛИ(J4=0;0;ЕСЛИ(J3>0,001;J3;ЕСЛИ(СЧЁТЕСЛИМН($B2:I2;0)>=2;МАКС($B2:I2);I2)))
 
Перейти    
Сопоставление строк между списками
 
#
24.06.2025 16:57:31
Перебор всех возможных комбинаций значений
Посмотрите такой вариант.
 
Перейти    
Суммирование значений, Суммирование значений в зависимости от даты
 
#
24.06.2025 15:54:00
Код
=СУММЕСЛИМН(C4:O4;C2:O2;"<="&H7)
 
Перейти    
Как сделать, чтобы строки не менялись в связанных таблицах, а только значения
 
#
24.06.2025 15:14:35
Код
вместо 'ссылка на таблицу назв листа'!U9:V11
напишите ДВССЫЛ("'ссылка на таблицу назв листа'!U9:V11")
PS Тема вполне себе пригодная для ветки Вопросы по Microsoft Excel
 
Перейти    
Перенести из одной колонки в другую часть цифр, формулой
 
#
24.06.2025 14:18:29
Код
=ЕСЛИОШИБКА(ПСТР(A2;НАЙТИ("_457";A2)+1;10);"")
Изменено: МатросНаЗебре - 24.06.2025 14:19:36
 
Перейти    
Поиск файлов на диске по маске имени и перемещение в другую папку, Перемещение файлов с неопределённым путём хранения
 
#
24.06.2025 09:57:34
Пишу в личку.
Сделал. Оплату получил.
Изменено: МатросНаЗебре - 24.06.2025 14:30:20
 
Перейти    
Проблема с выпадающим списком через ДВССЫЛ, Некорректно работает функция ДВССЫЛ с некоторыми ячейками
 
#
23.06.2025 16:31:04
Цитата
написал:
такую проверку данных достаточно
... пока не вставят ВВГнг(А)-LS.
 
Перейти    
Проблема с выпадающим списком через ДВССЫЛ, Некорректно работает функция ДВССЫЛ с некоторыми ячейками
 
#
23.06.2025 15:54:39
Цитата
написал:
в остальных случаях срабатывает.
Нет. ВВГнг-П тоже не работает.
 
Перейти    
Проблема с выпадающим списком через ДВССЫЛ, Некорректно работает функция ДВССЫЛ с некоторыми ячейками
 
#
23.06.2025 15:53:53
Код
=ДВССЫЛ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(K4;"-";"_");"(";"_");")";""))
 
Перейти    
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 281 След.
Наверх