Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Не получается вывести элементы словаря в ListBox
 
#1
14.12.2017 09:31:30
В целом виде тут должен быть расчет сколько человек отработал, но промежуток не сутки а с 4 утра одного дня до 3 утра другого, написанный участок рассчитывает пары вход выход просто за сутки и должен выводить итог в ListBox после каждого дня, но он пишет ошибку, и я как то не могу понять что ему не так. Я с VBA работаю почти что в первый раз и возможно не вижу очевидного.
Ну и как можно на VBA разделить на подобные "смены" хотя бы в плане идеи тоже хотелось бы прочитать если есть какие мысли.
 
 
 
#2
14.12.2017 12:32:52
Если вопрос заполнения, то
Код
            For i = 1 To sl.Count
                ListBox1.AddItem sl.Item(i)
            Next i
По вопросам из тем форума, личку не читаю.
 
 
 
#3
14.12.2017 12:59:31
Такой вариант показывает пустой лист бокс,  хотя по коду должно находится хотя бы 0:00:00  и 8:00:00.
А если по изголяться и сделать так
Код
            Dim e as Data
            For i = 1 To sl.Count
                e = sl.Item(i)
                ListBox1.AddItem e
            Next i
то 12:00:00 появляется.
Изменено: Cmehotron - 14.12.2017 13:09:20
 
 
 
#4
14.12.2017 13:40:54
не знаю, у меня все показывает
По вопросам из тем форума, личку не читаю.
 
 
 
#5
14.12.2017 14:51:15
Код
                  If Not a = 0 And Not b = 0 Then
                    If p Then
                        c = (b - a) - c  'Если второй выход и далее
                        b = 0
                    Else
                        c = c + (b - a)
                        b = 0
                        p = True
                    End If
                End If
                f = f + c
            End If
            If sl.exists(d) Then
                sl(d) = f
            Else
                sl(d) = f
                f = 0
            End If
        Next r
            For i = 1 To sl.Count
                ListBox1.AddItem sl.Item(i)
            Next i
    End If
End Sub
Сюда помещаете?
Изменено: Cmehotron - 14.12.2017 14:51:33
 
 
 
#6
14.12.2017 20:04:25
Код
Me.ListBox1.List = sl.Items()' выгрузка массива итемов в лист бокс
 
 
 
#7
14.12.2017 20:43:56
oldy7 ваш вариант работает, а не подскажите почему в моем варианте выдавал пустые  Items ?
 
 
 
#8
14.12.2017 21:18:19
Cmehotron, у Вас ключи как индексы идут или стрингами (фамилии, etc)? Если второе, то в примененном подходе просто не откуда брать итемы - ключей нет (хотя по идее должно выдаваться сообщение об ошибке).
 
 
 
#9
15.12.2017 08:03:59
Загружаются  как Data, а в 2010 работать такой метод будет?
Код
    Dim m(), r

Private Sub ComboBox1_Click()
    Dim ti, d As Double, s$, t As Double, sl: Set sl = CreateObject("Scripting.Dictionary")
    Dim tt, slo: Set slo = CreateObject("Scripting.Dictionary")
    
                Dim a, b, c, f, e As Date
                Dim p As Boolean
    
    spis.Clear
    ListBox1.Clear
    
    If Len(ComboBox1.Text) > 0 Then
        ti = ComboBox1.Text
                a = 0 'вход
                b = 0 'выход
                c = 0 'сумма промежуточная
                f = 0 'на экран сумма
        For r = UBound(m) To 4 Step -1
            If m(r, 8) = ti Then
                d = DateValue(m(r, 2))
                t = m(r, 3)
                s = m(r, 4)
                                                           
                If s = "Вход" Then
                    If a > 0 Then
                        If Not c = 0 Then
                            a = m(r, 3)
                            c = 0
                            p = False
                        End If
                    Else
                            a = m(r, 3)
                            f = f + c
                            c = 0
                            p = False
                    End If
                End If
                
                If s = "Выход" Then
                    If b > 0 Then
                        If Not c = 0 Then
                            If Not a = 0 Then
                                  b = m(r, 3)
                            End If
                        End If
                    Else
                        If Not a = 0 Then
                            b = m(r, 3)
                        End If
                    End If
                End If
                
                If Not a = 0 And Not b = 0 Then
                    If p Then
                        c = (b - a) - c  'Если второй выход и далее
                        b = 0
                    Else
                        c = c + (b - a)
                        b = 0
                        p = True
                    End If
                End If
                f = f + c
            End If
            If sl.exists(d) Then
                sl(d) = f
            Else
                sl(d) = f
                f = 0
            End If
        Next r
            For i = 1 To sl.Count
                ListBox1.AddItem sl.Item(i)
            Next i
    End If
End Sub

Private Sub UserForm_Initialize()
    Dim lr, t, sl: Set sl = CreateObject("Scripting.Dictionary")
    With Worksheets("Лист1")
        lr = .Cells(.Rows.Count, 2).End(xlUp).Row
        m = .[a1].Resize(lr, 8).Value
        
        ComboBox1.Clear
        For r = 4 To lr
            t = m(r, 8)
            If Len(t) > 0 Then
                If Not sl.exists(t) Then
                    sl(t) = 1
                    ComboBox1.AddItem t
                End If
            End If
        Next r
        
        
    End With
End Sub
 
 
 
#10
15.12.2017 10:00:20
Цитата
Cmehotron написал:
ComboBox1.Clear
Тут лишнее. Форма же только открылась.
Код
If Len(t) > 0 Then
Здесь Вы дату так проверяете? Даты для экселя - числа конвертируемые его движком в привычный для нас вид. У Вас даты в текстовом формате в таблице (сорри, не смотрел пример)?
----------
Если вдруг листбокс начнет упрямится, то есть альтернативный вариант загрузки после загрузки в словарь (раз массивом не нравится):
Код
ReDim qwe(0 to sl.Count-1)
Me.ComboBox1.List = qwe'загоняем пустой массив равный кол-ву элементов в словаре в комбобокс
for r=0 to Ubound(qwe)
ComboBox1.List (r)= sl.Item(sl.Keys()(r))'итем словаря по ключу с индексом взятым из переменной цикла
Next r
Изменено: oldy7 - 15.12.2017 10:18:02
 
 
 
#11
15.12.2017 10:32:05
Доброе время суток.
Коллеги, а зачем вы ListBox циклом заполняете? Не проще что его, что ComboBox сразу заливать значениями для случая одностолбцового построения?
Код
Dim pDict As Object
    Set pDict = CreateObject("Scripting.Dictionary")
    pDict("one") = "Один"
    pDict("two") = "Два"
    pDict("three") = "Три"
    ComboBox1.List = pDict.Items
    ListBox1.List = pDict.Items
 
 
 
#12
15.12.2017 11:12:48
oldy7 не это проверка, наличие фамилии, при инициализации просто в ComboBox забивается фамилии, и отсекаются пустые, и повторяющиеся; после просто при выборе из него фамилия просматривается все данные к этой фамилии.

Андрей VG в моем 2010 такой вариант выдаёт такой результат
 
 
 
#13
15.12.2017 11:16:57
Цитата
Cmehotron написал:
выдаёт такой результат
А какой вариант он должен был выдать? Вы заносите время. Время - это десятичная доля суток, следовательно число. Просто поставьте в столбце 3 формат Общий - что увидите?. Если вам нужно текстовое представление времени, то пишите в значения словаря время, используя функцию Format
 
 
 
#14
15.12.2017 11:21:33
вот такая конструкция работает, но это не слишком?
Код
    Dim u
    Dim ttt As Date
    Dim dd As Date   
        u = sl.keys
        For r = 0 To UBound(u)
            dd = (u(r))
            ttt = sl(u(r)) - slo(u(r))
            ListBox1.AddItem dd & " - " & ttt
        Next r
Изменено: Cmehotron - 15.12.2017 11:22:23
 
 
 
#15
16.12.2017 08:38:25
Стоит обращать внимание на "события" при расчете входа и выхода? Если да, то там все наоборот. Устройство "Вход", событие "Выход" и наоборот.
---------------
Во вложении альтернативный вариант решения. В коде есть комменты.

Для одновременного выделения во всех листбоксах при синхронной прокрутке нужно поменять, что есть в файле на это:
Код
Private Sub spis_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
     With Me.spis
     On Error Resume Next
          .Selected(.TopIndex + Y \ 10) = True
          ListBox1.Selected(ListBox1.TopIndex + Y \ 10) = True
          ListBox2.Selected(ListBox2.TopIndex + Y \ 10) = True
          ListBox3.Selected(ListBox3.TopIndex + Y \ 10) = True
     On Error GoTo 0
     End With
End Sub
Изменено: oldy7 - 16.12.2017 08:45:38
 
 
 
#16
18.12.2017 08:20:47
Нет событие не важно, там регистрируется сбои энергии, отказы и прочее, этот аппарат не той стороной установили просто. Почитаем ваше решение.
Изменено: Cmehotron - 18.12.2017 08:22:57
 
 
 
#17
18.12.2017 10:20:30
Исправил пару ошибок. В теории можно еще ввести проверку на ложное срабатывание , т.е. игнорить промежутки между входами/выходами до минуты, попытаться отловить полтергейстов (некоторые сотрудники умудрялись только заходить или выходить). Ну и еще сделать кликабельным список в комбобокс с сортировкой по времени/дате.
Изменено: oldy7 - 18.12.2017 12:21:44
 
 
 
#18
19.12.2017 10:46:57
Смотрю в код и вижу недостаток образования, не мой уровень, пустые поля без фамилию считать думаю вообще не надо считывать, а кликабельный комбобокс нужен по любому, если за месяц такой отчет будет очень большим и другие люди будут глаз мылить.  
 
 
 
#19
19.12.2017 12:59:33
Cmehotron, на самом деле труднее читать чужой код, чем написать свой)
 
 
 
#20
19.12.2017 14:39:23
Эм, такой вопрос а как вот этот участок работает?
Код
     pp = Chr(255) & Chr(255) & Chr(255) & Chr(255)
    Else
     pp = -9999999999#
 
 
 
#21
20.12.2017 11:45:45
Cmehotron,  это сортировщик, точнее его часть определяющая на что на первом этапе заменять пустые строки в массиве) Он тут постольку-поскольку. Т.е. можно , и многие именно это и посоветовали бы, задействовать родной экселевский сортировщик.

П.С.: Данный сортировщик общего назначения и не писался именно под вашу задачу. Был готовый вариант, сделал из него функцию и прилепил.
Изменено: oldy7 - 20.12.2017 11:48:16
 
 
 
Страницы: 1
Читают тему
Наверх