Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 След.
скролл UserForm через колесико мыши, как прокрутить UserForm с данными с помощью колесика мыши
 
благодарю код этот нашел но не мог сынтегрировать его в сисету
скролл UserForm через колесико мыши, как прокрутить UserForm с данными с помощью колесика мыши
 
Смотрел не то,
мне нужно проскролить саму UserForm1 в низ или вверх с помощью колеса мышки. Форма будет наполняться 1000 данных в низ, поэтому форма будет еще длиннее в низ, для лучшего управления формой планирую прокручивать колесо мыши, чтобы форма проскреливалась в низ и верх для
скролл UserForm через колесико мыши, как прокрутить UserForm с данными с помощью колесика мыши
 
Привет вобще можно както зделать скрол UserForm через колесо мыши
Ввод данных с TextBox в диапазон при условии разных искомых значений
 
Могу только все по отдельности.

Код
Private Sub Record_read_1()
For Each cell In ActiveWorkbook.Sheets("Лист2").Range("AL1: AL5000")
If cell.Value = ("1") & ("Салат") Then
With Sheets("Лист2").Range("AM" & cell.Row)
.Value2 = Me.TextBox1
End With
End If
Next
End Sub
Private Sub Record_read_2()
For Each cell In ActiveWorkbook.Sheets("Лист2").Range("AL1: AL5000")
If cell.Value = ("2") & ("Торт") Then
With Sheets("Лист2").Range("AM" & cell.Row)
.Value2 = Me.TextBox2
End With
End If
Next
End Sub
Private Sub Record_remove_1()
For Each cell In ActiveWorkbook.Sheets("Лист2").Range("AL1: AL5000")
If cell.Value = Me.TextBox1 Then
With Sheets("Лист2").Range("AL" & cell.Row)
.Value2 = ClearContents
End With
End If
Next
End Sub
Private Sub Record_remove_2()
For Each cell In ActiveWorkbook.Sheets("Лист2").Range("AL1: AL5000")
If cell.Value = Me.TextBox2 Then
With Sheets("Лист2").Range("AL" & cell.Row)
.Value2 = ClearContents
End With
End If
Next
End Sub
Изменено: Ян Копко - 09.08.2021 10:38:12
Вывод данных в TextBox по 4-м условиям ComboBox
 
здравствуйте!
Подскажите как дописать код. С другой книги берутся данные, при выборе имени в ComboBox1 Сергей и дате в ComboBox9 28.07.2021 ИР в ComboBox7 10.16.240.51 в ComboBox8 оставалася только запись 16:04:49 Сергей, при нажатии в TextBox15 выводилась инфа Волгодонск, Березовая ул., д.98
Практически так все и работает, но криво. На мой взгляд он фильтрует по ComboBox7/8 адекватно, по остальным не очень.
Это часть кода, сбрасываю без дополнительного файла но с листом данных лист2.
Как переделать код для того чтобы он отфильтровал по нужным данным
Благодарю Вас за труд!
Код
Private Sub ComboBox1_Change()
Call AccelerateBegin
'Windows("1 Chat.xlsb").Visible = True
Application.Workbooks.Open ("d:\-\Profiles\DeskTop\Новая папка\2.xlsb")
Dim i As Long, LastRow As Long, kategorija As String
kategorija = Me.ComboBox1
With Sheets("лист2")
LastRow = .Cells(Rows.Count, 84).End(xlUp).Row
For i = 2 To LastRow
If .Cells(i, 84) = kategorija Then
Me.ComboBox9.AddItem .Cells(i, 86)
End If
Next
End With
'Windows("1 Chat.xlsb").Visible = False
Call AccelerateEnd
End Sub
Private Sub ComboBox9_Change()
Call AccelerateBegin
Application.Workbooks.Open ("d:\-\Profiles\DeskTop\Новая папка\2.xlsb")
'Windows("1 Chat.xlsb").Visible = True
Dim i As Long, LastRow As Long, kategorija As String
Me.ComboBox7.Clear
kategorija = Me.ComboBox9
With Sheets("лист2")
LastRow = .Cells(Rows.Count, 86).End(xlUp).Row
For i = 2 To LastRow
If .Cells(i, 86) = kategorija Then
Me.ComboBox7.AddItem .Cells(i, 87)
End If
Next
End With
'Windows("1 Chat.xlsb").Visible = False
Call AccelerateEnd
End Sub
Private Sub ComboBox7_Change()
Call AccelerateBegin
'Windows("1 Chat.xlsb").Visible = True
Dim i As Long, LastRow As Long, kategorija As String
Me.ComboBox8.Clear
kategorija = Me.ComboBox7
With Sheets("лист2")
LastRow = .Cells(Rows.Count, 87).End(xlUp).Row
For i = 2 To LastRow
If .Cells(i, 87) = kategorija Then
Me.ComboBox8.AddItem .Cells(i, 88)
End If
Next
End With
'Windows("1 Chat.xlsb").Visible = False
End Sub
Private Sub ComboBox8_Change()
Call AccelerateBegin
'Windows("1 Chat.xlsb").Visible = True
Dim i As Integer, a
With Worksheets("лист2")
For i = 2 To .Cells(Rows.Count, 88).End(xlUp).Row
If .Cells(i, 88).Value = ComboBox8.Value Then
If a = "" Then
a = .Cells(i, 89).Value
Else
End If
End If
Next i
End With
TextBox15.Value = a
'Windows("1 Chat.xlsb").Visible = False
Call AccelerateEnd
End Sub

Private Sub CommandButton1_Click()

End Sub

Private Sub CommandButton2_Click()
Call AccelerateBegin
'Windows("2.xlsb").Visible = True
'ActiveWorkbook.Save
'Application.Workbooks("2").Close
'Application.ScreenUpdating = True
Unload Me
End Sub
Изменено: Ян Копко - 29.07.2021 18:15:46
Свод данных в таблицу по времени и дате убывания
 
Благодарю Вас, буду разбираться
Свод данных в таблицу по времени и дате убывания
 
Мне надо окончательный результат как у Николая в образце, но данная таблица статическая, ее надо будет постоянно формировать при открытии
+ в моих таблицах все заголовки одинаковые
Свод данных в таблицу по времени и дате убывания
 
Изменил текст
Прошу помочь в написании макроса. Макрос должен делать следующие действия
1) Сформировать таблицу на листе 1 в диапазоне А2:G100 c диапазона H2:AI100 по времени и дате по убыванию.

Прикрепил файл
Изменено: Ян Копко - 22.07.2021 14:39:23
Свод данных в таблицу по времени и дате убывания
 
Подскажите в какую сторону смотреть?
Свод данных в таблицу по времени и дате убывания
 
Здравствуйте!
Подскажите пожалуйста очень нужна Ваша помощь как мне поступить?
В файл Excel Лист 1 собирается информация с 20 паралельних файлов, через ячейка основного файла = ячейке файла 1.2 и тд... Информация собирается в отдельную колонку в одном Листе 1 из всех файлов. У всех файлах расстановка данных на листе одинаковая как в примере, и она обновляется от 1-минуты до 24-часа (динамическая).
Как мне сформировать таблицу чтобы при открытии основного файла весь боем информации с Листа 1 сформировалась на Листе 3 по времени и дате убывания.

Дальше она будет отображаться в TextBox потому надо чтобы она формировалась в момент открытия автоматически.
Я никогда не сталкивался с умной таблицей может она мне в этом помочь?
Может формулами как то можно это сформировать?

По этому нашел не большой макрос.
Вот тут
И сам код
Код
Sub Запуск1()

    Dim shSrc As Worksheet, shRes As Worksheet, arrSrc(), dicDates As Object, dic As Object
    Dim lr As Long, lc As Long, var, r As Long, i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    Set shSrc = ActiveSheet
    Set shRes = Worksheets.Add(After:=shSrc)
    
    lr = shSrc.Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    lc = shSrc.Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Column
    arrSrc() = shSrc.Range("A1").Resize(lr, lc).Value
    
    Set dicDates = CreateObject("Scripting.Dictionary")
    
    For i = 2 To UBound(arrSrc, 1)
        For j = 3 To UBound(arrSrc, 2)
            If IsEmpty(arrSrc(i, j)) = False Then
                If dicDates.Exists(arrSrc(i, j)) = False Then
                    dicDates.Add arrSrc(i, j), ""
                End If
            End If
        Next
    Next
    
    Set dic = CreateObject("Scripting.Dictionary")
    
    For Each var In dicDates.Keys
        dic.RemoveAll
        For i = 2 To UBound(arrSrc, 1)
            For j = 3 To UBound(arrSrc, 2)
                If arrSrc(i, j) = var Then
                    dic.Add arrSrc(i, 1), ""
                    Exit For
                End If
            Next
        Next
        If dic.Count > 0 Then
            r = r + 1
            shRes.Cells(r, "A").Value = var
            shRes.Cells(r, "B").Resize(1, dic.Count).Value = dic.Keys
        End If
    Next

    shRes.Sort.SortFields.Clear
    shRes.Sort.SortFields.Add Key:=shRes.Columns("A"), SortOn:=xlSortOnValues, Order:=xlAscending
    With shRes.Sort
        .SetRange shRes.Range("A1").CurrentRegion
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
    
    shRes.Columns("A").AutoFit
    
    Application.ScreenUpdating = True
    
End Sub
Изменено: Ян Копко - 22.07.2021 12:47:37
Удалить данные из столбца В, если дата в столбце А меньше текущей
 
Благодарю Вас  vikttur
Удалить данные из столбца В, если дата в столбце А меньше текущей
 
Здравствуйте
Не могу решить проблему, нужно чтобы код проверял на листе 2 диапазон А5:А15 и если ячейка содержит дату меньшую чем сегодня - 7 часов, тогда очистить данные в ячейке напротив этой даты колонки В. (улицы)
Данный код очки читает только первую найденную ячейку.

Код
 Sub gfh()
 For Each cell In ActiveWorkbook.Sheets("Лист2").Range("A5:A15")

If cell.Value < Int(Now - 7 / 24) Then
    With Range("B" & cell.Row)
    .Value2 = ""
 End With
Exit Sub
End If
Next
End Sub
Изменено: vikttur - 21.07.2021 11:17:16
Отображение данных в TextBox из диапазона неактивного листа
 
RAN Премного благодарен Вам!!
Изменено: Ян Копко - 16.07.2021 12:18:28
Отображение данных в TextBox из диапазона неактивного листа
 
Вадим Благодарю Вас приму во внимание но мне кажется что данный код неподходит. К немо еще больше вопросов и действий предстоит сделать эжели с моим
RAN   то такой функции нету? я все верно понял и мне надо разбираться с файлом Вадима.
Изменено: Ян Копко - 15.07.2021 19:28:30
Отображение данных в TextBox из диапазона неактивного листа
 
Здравствуйте!
Нужна Ваша помощь.                                                                                                                                                                                                                                        
Отображения диапазона данных СN1:СN1000 с неактивного Листа2 в TextBox3 чтоб он вмещался в TextBox3 и был читабелен, при добавлении данных в диапазон СN1:СN1000 можно было бы скролить в низ TextBox3.
Как отобразить диапазон СN1:СN1000 данных в TextBox3 из не активного Листа2, почему именно TextBox, по причине очень большого текста данных диапазона СN1:СN1000 который будет вмещаться в TextBox3 с помощу кода Me.TextBox3.MultiLine = True. Или подскажите свой вариант пожалуйста.
Код
Me.TextBox3.Value = Sheets("Лист2").Range("СN1:СN1000").Value
Sheets("Лист2").Range("СN1:СN1000").Value = TextBox3.Value
Есть два кода не могу доделать.
Ошибка else without if
 
Юрий М благодарю.!
Jack Famous да я заметил, но меня это устраивает
Ошибка else without if
 
Благодарю Вас, все отлично работает
Ошибка else without if
 
Пробовал
Код
Else
Call MsgBox("все ок", vbOKOnly, "")
End If
End Sub

Код
Else
Call MsgBox("все ок", vbOKOnly, "")
End If
Next
End Sub
не работает
Изменено: Ян Копко - 02.07.2021 17:12:36
Ошибка else without if
 
Здравствуйте!
Если TextBox9 > 24  тогда запуск Марос1_1
Если TextBox11 > 46 тогда запуск Марос1_2

Если все два значения не верни тогда макрос Call MsgBox("все ок", vbOKOnly, "")

Но код не работает выдает ошибку
Подскажите как решить проблему с else without if

Код
Private Sub CommandButton1_Click()

Call Марос1

End Sub
Private Sub Марос1()
If TextBox9 > 24 Then Call Марос1_1
If TextBox11 > 46 Then Call Марос1_2
Else
Call MsgBox("все ок", vbOKOnly, "")
End Sub
Private Sub Марос1_1()
If MsgBox("проблема 1" & vbNewLine & "" & vbNewLine & "" & vbNewLine & "!!!" & vbNewLine & "" & vbNewLine & "" & Chr(34) & "" & Chr(34) & "  " & Chr(34) & "" & Chr(34) & " ", vbYesNo + vbExclamation, "") = vbYes Then
Call MsgBox("Решено1", vbOKOnly + vbInformation, "")
'Call Input_selection3
End If
End Sub
Private Sub Марос1_2()
If MsgBox("проблема 2" & vbNewLine & "" & vbNewLine & "" & vbNewLine & "" & vbNewLine & "" & vbNewLine & "" & Chr(34) & "" & Chr(34) & "  " & Chr(34) & "" & Chr(34) & "   ", vbYesNo + vbExclamation, "") = vbYes Then
Call MsgBox("Решено2", vbOKOnly + vbInformation, "")
'Call Input_selection3
End If
End Sub
Изменено: Ян Копко - 02.07.2021 17:01:54
Запись данных в строку искомого значения
 
Благодарю за помощь
Запись данных в строку искомого значения
 
Здравствуйте!
Ниже на веден код который ищет числа по диапазону AK1:CC1 с UserForm001  ComboBox7, если их нет тогда MsgBox что их нет, если данные присутствуют в диапазоне  AK1:CC1 тогда надо ввести значение с ComboBox7 в 2-строку под этим числом.

Подскажите ка мне реализовать запис с ComboBox7 во 2-строку под этим числом.
Код
Private Sub Input001_selection2()
 x_text = Me.ComboBox7
    Dim cell As Range
Set cell = Worksheets("1").Range("AK1:CC1").Find(What:=x_text, LookIn:=xlValues, LookAt:=xlWhole)
    If cell Is Nothing Then
            Call MsgBox("Ничего нету" & vbNewLine & "в" & vbNewLine & "в" & vbNewLine & "в", vbOKOnly + vbCritical, "")
    Else

'Вот здесь надо чтобы данные вводились с ComboBox 7 во 2-строку под искомым числом.

Call MsgBox("Заполнил проверяй", vbOKOnly, "")
     
    End If
Unload UserForm001
End Sub
Изменено: Ян Копко - 09.06.2021 07:40:04
Смещение данных вниз после ввода диапазона с UserForm1
 
Благодарю Вас V все работает!!! как и планировал даже лучше)))
Изменено: Ян Копко - 04.06.2021 14:59:23
Смещение данных вниз после ввода диапазона с UserForm1
 
Здравствуйте!
На Вашем сайте нашел код МатросНаЗебре но не как не могу доделать, чтобы после ввода с UserForm1 диапазона код заработал
Код
'Код-1
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    Dim x As Long
   If Not Intersect(Target, Range("A2:AF2")) Is Nothing Then
        y = Target.Column
        Range(Cells(10, y), Cells(31, y)).Copy Destination:=Cells(11, y)
        Cells(10, y) = Target
    End If
End Sub

Если вводить
Код
 'Код-2
    Worksheets("Лист1").Cells( 2, 2) = Me.TextBox14
    Worksheets("Лист1").Cells( 2, 3) = Me.TextBox5
    Worksheets("Лист1").Cells( 2, 4) = Me.ComboBox4
    Worksheets("Лист1").Cells( 2, 5) = Me.ComboBox1

Код смещения на Листе1 работает, но мне он не подходит по причине продолжительной записи ввод 40+ с UserForm1

Если вводить
Код
 'Код-2
Private Sub CommandButton1_Click()
With Worksheets("Лист1")
.Range("A2:I2") = Array(Me.TextBox14,  Me.TextBox5, Me.ComboBox4, Me.ComboBox1, Me.TextBox3, Me.TextBox1, Me.TextBox2, Me.TextBox4, Me.TextBox12)
End With
End
End Sub

А с этим кодом с  UserForm1 не хочет работать
Подскажите ка изменить код смещение (1-й код), чтобы он заработал с кодом ввода диапазона (3-й код)
Изменено: Ян Копко - 04.06.2021 14:48:53
Cдвинуть данные столбца вниз при вводе данных
 
Благодарю Вадим
Тогда буду ждать помощи
Изменено: Ян Копко - 04.06.2021 13:03:17
Cдвинуть данные столбца вниз при вводе данных
 
Вадим, Вы случайно не делали для целого диапазона вставки. Когда с UserForm1 вводятся данные и они сдвигаются, в коде Igor67 сдвигается строка только если вводить поочередно .

Когда ввожу этим кодом работает, но мне этот код не подходит
Код
   
    Worksheets("Лист1").Cells( 2, 2) = Me.TextBox14
    Worksheets("Лист1").Cells( 2, 3) = Me.TextBox5
    Worksheets("Лист1").Cells( 2, 4) = Me.ComboBox4
    Worksheets("Лист1").Cells( 2, 5) = Me.ComboBox1  
    Worksheets("Лист1").Cells( 2, 6) = CDbl(Me.TextBox3)
    Worksheets("Лист1").Cells( 2, 7) =  CDbl(Me.TextBox1)
    Worksheets("Лист1").Cells( 2, 8) = CDbl(Me.TextBox2)
    Worksheets("Лист1").Cells( 2, 9) =  Me.TextBox4
    Worksheets("Лист1").Cells( 2, 10) =  Me.TextBox12
    

Когда ввожу этим кодом не работает, нужно вводить  этим кодом данние
Код
With Worksheets("Лист1")
.Range("A2:I2") = Array(Me.TextBox14, Me.TextBox5, Me.ComboBox4, Me.ComboBox1, CDbl(Me.TextBox3), CDbl(Me.TextBox1), CDbl(Me.TextBox2), Me.TextBox4, Me.TextBox12)
End With
End

Как можно изменить данный код для вше упомянутой вставки данных
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:I2")) Is Nothing Then

        With Range("A2:I2" & cell.Row)    'Добавил в код но ничего не изменилось

        Target.Insert Shift:=xlDown
   '     Target.Interior.Color = xlNone
   '     Target.Offset(-1, 0).Interior.Color = 65535
        Target.Offset(-1, 0).Value = Target.Value
        End With
    End If
End Sub

Очень надо, поделитесь если єсть.

Или лучше новую тему создать, подскажите (модератор)
Изменено: vikttur - 05.06.2021 00:15:40
Поиск и фильтрация всех данных которые совпадают с искомыми значениями и ComboBox1 и ComboBox2
 
Mershik благодарю за помощь
Wiss благодарю за помощь и напутствие
Поиск и фильтрация всех данных которые совпадают с искомыми значениями и ComboBox1 и ComboBox2
 
Здравствуйте!

Ниже наведен код, который ищет данные в колонке А и выводит от 1 и более строк с совпадениями.

Когда ввожу данные с UserForm1  ComboBox1 фильтр подтягивает все числа там где они сами и там где они присутствуют с другими числами.
Когда ввожу данные с UserForm1  ComboBox1 и  ComboBox2 в одну ячейку фильтрация подтягивает диапазон там где эти числа присутствуют в месте а там где раздельно нет.

Нужно при вводе данных в колонку А2 с UserForm1  ComboBox1 и  ComboBox2 в одну ячейку А2 фильтр отфильтровывал все числа даже те которые присутствуют одни в строках и те которые присутствуют вместе с остальными.

Пример при выборе данных с ComboBox1 числа 12.14.01 и ComboBox2 числа 12.14.02 вводились данные в ячейке А2  *12.14.01** 12.14.02* после чего фильтр отфильтровал строки сданными *12.14.01* и *12.14.01*12.14.02* и *12.14.02*

Есть возможность это решить?

Код
Private Sub Worksheet_Change(ByVal Target As Range)
     If Not Intersect(Target, Range("A2:D2")) Is Nothing Then
         Application.EnableEvents = False
      On Error Resume Next
         ActiveSheet.ShowAllData
         Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:D2")
         Application.EnableEvents = True
         End If
End Sub
Изменено: Ян Копко - 02.06.2021 11:41:17
Отображение уникальных позиций в ComboBox-ах
 
МатросНаЗебре Mershik   Благодарю Вас !!!!! все работает.
Изменено: Ян Копко - 28.05.2021 07:07:39
Отображение уникальных позиций в ComboBox-ах
 
Извините но у меня почему то ComboBox2 пустой без списка вовсе.
что не то я делаю
Изменено: Ян Копко - 27.05.2021 17:40:19
Отображение уникальных позиций в ComboBox-ах
 
Здравствуйте
На Вашем сайте когда то нашел код (было давно ссылку не помню), немного переделал под свои запроси.
При выборе данных в выпадающем списке ComboBox1 они отфильтровываются для отображение данных в ComboBox2/3, то есть в ComboBox2 и  ComboBox3 можно выбрать один и тот же продукт, как сделать так чтобы при выборе в  ComboBox1 (канцелярские) а в ComboBox2 (бумага) то в  ComboBox3 она уже не отображается, или не возможно было бы   ее вибрать.
Код
Private Sub UserForm_Initialize()
'(отбор уникальных значений) 
Dim AllCells As Range, rCell As Range
Dim NoDupes As New Collection
Dim Item
    
    With Worksheets("справка")
    'Элементы находятся в столбце A
        Set AllCells = .Range("AA2:AA" & .Cells(Rows.Count, 27).End(xlUp).Row)
    End With
    'заполняем коллекцию элементами без повторений
    On Error Resume Next
    For Each rCell In AllCells
        NoDupes.Add rCell.Value, CStr(rCell.Value)
    Next rCell
    On Error GoTo 0

    'Добавление уникальных значений в  ComboBox
    For Each Item In NoDupes
        Me.ComboBox1.AddItem Item
    Next Item
End Sub


Private Sub ComboBox1_Change()
Dim i As Long, LastRow As Long, kategorija As String
    Me.ComboBox2.Clear
        Me.ComboBox3.Clear
    kategorija = Me.ComboBox1
    With Sheets("справка")
        LastRow = .Cells(Rows.Count, 27).End(xlUp).Row
        For i = 2 To LastRow
            If .Cells(i, 27) = kategorija Then
                Me.ComboBox2.AddItem .Cells(i, 28)
                            Me.ComboBox3.AddItem .Cells(i, 28)
            End If
        Next
    End With
End Sub
Страницы: 1 2 3 4 5 След.
Наверх