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

Страницы: 1
Достать значения столбца при выполнении условия в другом столбце VBA
 
#
26.04.2023 16:22:41
Александр Федоров, предоставьте пожалуйста пример данных.
 
Перейти    
Ждет ли макрос обновления данных в книге?, VBA/PQ
 
#
22.03.2023 10:29:15
Валерий Кишин, здравствуйте.
Делайте Refresh с параметром BackgroundQuery
Код
Table.Refresh BackgroundQuery:=False
 
Перейти    
Составить список по заданному фильтру из таблицы
 
#
21.03.2023 18:19:26
Viktor, пример высланный вам не подразумевал его поддержку, если такая необходимость есть мы можем обменяться контактами и я буду поддерживать данный код.
Проблема заключается в том что в коде не предусмотрено повторение значений в строке 2 на листе "Лист4".
Например:
Виктор Наталия Екатерина Наталия - будет ошибка, т.к. 2 раза встречается имя Наталия

Так же макросом не предусмотрено следующее:
на листе "Лист3" если в столбце "ДОЛЖНОСТЬ" есть данные, то в столбце "ИСПОЛНИТЕЛЬ" так же должны находиться данные, иначе ошибка.
Если в столбце "ДОЛЖНОСТЬ" данных нет, то столбце "ИСПОЛНИТЕЛЬ" не берется в обработку
 
Перейти    
Убрать лишнее в макросе
 
#
16.03.2023 16:45:11
Владислав, здравствуйте.
Возможно вам подойдет следующее(Внимание, код не рабочий, просто призыв к реализации):
Код
newRow.range(НомерСтолбца).value = КнигаСДанными.НужныйЛист.Range("N17").value
Копировать и вставлять по 1 значению не нужно.

Цикл по столбцам строки выглядит(код не проверялся на работоспособность):
Код
For Column=1 to newRow.range.columns.count
   newRow.range(Column).value = Column
next Column
Изменено: Павел - 16.03.2023 16:46:13
 
Перейти    
Составить список по заданному фильтру из таблицы
 
#
16.03.2023 14:38:34
Jack Famous, Спасибо.
 
Перейти    
Составить список по заданному фильтру из таблицы
 
#
16.03.2023 14:24:47
Viktor, Вы можете добавлять строки в таблицу.
если появятся новые профессии, то необходимо будет изменить диапазон("Лист2!$A$2:$P$2")
Код
Const JOB_RANGE As String = "Лист2!$A$2:$P$2"
 
Перейти    
Составить список по заданному фильтру из таблицы
 
#
16.03.2023 14:19:55
Viktor, Проблема в том что некоторые профессии имеют ПРОБЕЛ в налале или конце строки
Исправил:
Код
Option Explicit
 
Const JOB_RANGE As String = "Лист2!$A$2:$P$2"
 
Sub Work()
    Dim JobCollection As New Collection
    Dim Job As Variant
     
    'создаем коллекцию профессий
    For Each Job In Range(JOB_RANGE)
        JobCollection.Add Item:=New Collection, Key:=Trim(Job.Value2)
    Next Job
     
    Dim Row As Variant
    Dim Column As Variant
    Dim ArrayJobs As Variant
    
    'считываем все задачи для всех профессий в коллекцию
    For Each Row In Sheets("Лист1").Range("Задачи").ListObject.ListRows
        For Column = 1 To Row.Range.Columns.Count Step 2
            If Not IsEmpty(Row.Range(Column).Value2) Then
                If InStr(1, Row.Range(Column + 1).Value2, ";", vbTextCompare) > 0 Then
                    For Each Job In Split(Row.Range(Column + 1).Value2, ";")
                        JobCollection(Trim(Job)).Add Item:=Row.Range(Column).Value2
                    Next Job
                Else
                    JobCollection(Trim(Row.Range(Column + 1).Value2)).Add Item:=Row.Range(Column).Value2
                End If
            End If
        Next Column
    Next Row
     
    Dim MyTask As Variant
    Dim StartRow As Long
     
    'выводим данные из коллекции
    For Each Job In Range(JOB_RANGE)
        If JobCollection(Trim(Job.Value2)).Count > 0 Then
            StartRow = Job.Row + 1
            For Each MyTask In JobCollection(Trim(Job.Value2))
                Range(JOB_RANGE).Parent.Cells(StartRow, Job.Column).Value = MyTask
                StartRow = StartRow + 1
            Next MyTask
        End If
    Next Job
    MsgBox "Готово"
End Sub
 
Перейти    
Составить список по заданному фильтру из таблицы
 
#
16.03.2023 13:54:36
Viktor, Данный код будет работать и на Windows и на Mac
 
Перейти    
Составить список по заданному фильтру из таблицы
 
#
16.03.2023 13:47:19
Jack Famous, Вы правы, спасибо.

Viktor Molbo, попробуйте этот вариант
Код
Option Explicit

Const JOB_RANGE As String = "Лист2!$A$2:$P$2"

Sub Work()
    Dim JobCollection As New Collection
    Dim Job As Variant
    
    'создаем коллекцию профессий
    For Each Job In Range(JOB_RANGE)
        JobCollection.Add Item:=New Collection, Key:=Job.Value2
    Next Job
    
    Dim Row As Variant
    Dim Column As Variant
    Dim ArrayJobs As Variant
    
    'считываем все задачи для всех профессий в коллекцию
    For Each Row In Sheets("Лист1").Range("Задачи").ListObject.ListRows
        For Column = 1 To Row.Range.Columns.Count Step 2
            If Not IsEmpty(Row.Range(Column).Value2) Then
                If InStr(1, Row.Range(Column + 1).Value2, ";", vbTextCompare) > 0 Then
                    For Each Job In Split(Row.Range(Column + 1).Value2, ";")
                        JobCollection(Trim(Job)).Add Item:=Row.Range(Column).Value2
                    Next Job
                Else
                    JobCollection(Row.Range(Column + 1).Value2).Add Item:=Row.Range(Column).Value2
                End If
            End If
        Next Column
    Next Row
    
    Dim MyTask As Variant
    Dim StartRow As Long
    
    'выводим данные из коллекции
    For Each Job In Range(JOB_RANGE)
        If JobCollection(Job.Value2).Count > 0 Then
            StartRow = Job.Row + 1
            For Each MyTask In JobCollection(Job.Value2)
                Range(JOB_RANGE).Parent.Cells(StartRow, Job.Column).value = MyTask
                StartRow = StartRow + 1
            Next MyTask
        End If
    Next Job
    MsgBox "Готово"
End Sub
 
Перейти    
Составить список по заданному фильтру из таблицы
 
#
16.03.2023 13:22:01
У вас Mac, об этом нужно было сказать.
Хотя сомнения были.

На мак нет необходимой библиотеки в которой содержится словарь.
Попробуйте воспользоваться ЭТИМ(класс-модуль Dictionary)
 
Перейти    
Составить список по заданному фильтру из таблицы
 
#
16.03.2023 12:42:52
Код
Option Explicit

Const JOB_RANGE As String = "Лист2!$A$2:$P$2"

Sub Work()
    Dim JobDictionary As Object
    Dim Job As Variant
    
    Set JobDictionary = VBA.CreateObject("Scripting.Dictionary")
    
    'создаем словарь профессий
    For Each Job In Range(JOB_RANGE)
        If Not JobDictionary.Exists(Job.Value2) Then
            JobDictionary.Add Key:=Job.Value2, Item:=New Collection
        End If
    Next Job
    
    Dim Row As Variant
    Dim Column As Variant
    Dim ArrayJobs As Variant
    
    'считываем все задачи для всез профессий в словарь
    For Each Row In Sheets("Лист1").Range("Задачи").ListObject.ListRows
        For Column = 1 To Row.Range.Columns.Count Step 2
            If Not IsEmpty(Row.Range(Column).Value2) Then
                If InStr(1, Row.Range(Column + 1).Value2, ";", vbTextCompare) > 0 Then
                    For Each Job In Split(Row.Range(Column + 1).Value2, ";")
                        JobDictionary(Trim(Job)).Add Item:=Row.Range(Column).Value2
                    Next Job
                Else
                    JobDictionary(Row.Range(Column + 1).Value2).Add Item:=Row.Range(Column).Value2
                End If
            End If
        Next Column
    Next Row
    
    Dim MyTask As Variant
    Dim StartRow As Long
    
    'выводим данные из словаря
    For Each Job In Range(JOB_RANGE)
        If JobDictionary(Job.Value2).Count > 0 Then
            StartRow = Job.Row + 1
            For Each MyTask In JobDictionary(Job.Value2)
                Range(JOB_RANGE).Parent.Cells(StartRow, Job.Column).Value = MyTask
                StartRow = StartRow + 1
            Next MyTask
        End If
    Next Job
    MsgBox "Готово"
End Sub
Изменено: Павел - 16.03.2023 12:55:53
 
Перейти    
Доступ к коллекции собственного класса через default свойство, Доступ к элементу коллекции из класса
 
#
14.11.2022 11:16:48
testuser, спасибо за ваше предложение, но при такой реализации теряю возможность видеть методы и свойства объекта Rows(если пишу " Rows."  <- то нет выпадающего списка с методами). Стремлюсь к реализации как у ListObject(код не рабочий, просто как пример):
Код
    Dim testListObject As ListObject
    testListObject.ListRows (1) '- возвращается строка
    testListObject.ListRows.Add ' - могу увидеть метод в выпадающем списке
 
Перейти    
Доступ к коллекции собственного класса через default свойство, Доступ к элементу коллекции из класса
 
#
11.11.2022 13:30:02
Тема: Доступ к коллекции собственного класса через default свойство
 
Перейти    
Доступ к коллекции собственного класса через default свойство, Доступ к элементу коллекции из класса
 
#
11.11.2022 10:40:14
Цитата
написал:
Почитайте классическую статью  http://www.cpearson.com/excel/DefaultMember.aspx
Спасибо за Ваш ответ.
При использовании атрибута возникает другая проблема.
При вызове свойства Rows из класса Table мне ожидаемо возвращается объект Rows для доступа к его методам и свойствам.
Но когда я вызываю конкретный экземпляр коллекции - Table.Rows(1), я хочу вернуть другой объект(в данном случае просто значение) и в свойстве Rows возникает ошибка '424' Object required

Для удобства, приложил файл с примером.
 
Перейти    
Доступ к коллекции собственного класса через default свойство, Доступ к элементу коллекции из класса
 
#
10.11.2022 10:44:09
Уважаемые, здравствуйте.
Как получить элемент коллекции или словаря из класса.
Пример:
Есть классы:
Table
Код
Option Explicit

Private obgRows As Rows

Public Property Get Rows(Optional Index As Long) As Rows
    Set Rows = obgRows
End Property

Public Property Let Rows(Optional Index As Long, rows_ As Rows)
    Set obgRows = rows_
End Property

Private Sub Class_Initialize()
    Set obgRows = New Rows
End Sub
Rows
Код
Option Explicit

Private Coll_ As New Collection

Public Property Get Item(Index_ As Long) As Long
    Index = Coll_(CStr(Index_))
End Property

Public Function Add(Index_ As Long)
    Coll_.Add Index_, CStr(Index_)
End Function
Модуль с процедурой
Код
Sub test()
    Dim cl As New Table
    Dim value As Variant
    Call cl.Rows.Add(1)
    Call cl.Rows.Add(2)
    value = cl.Rows.Item(1)
End Sub

Сейчас я получаю значение из коллекции в классе Rows через свойство Item.
А хотелось бы получать нужный item напрямую из Rows:
value = cl.Rows(1)

Пробовал решить задачу через атрибут(разместил его в Item) но проблема в том, что в свойство item не приходит значение. Например:
cl.Rows(1) -> в Table.Rows Index=1, затем переходим в Rows.Item. а здесь уже Index=0

Прошу оказать содействие.  
Изменено: Юрий М - 11.11.2022 13:34:49
 
Перейти    
Страницы: 1
Наверх