Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Посчитать процент заполнения формы VBA - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Посчитать процент заполнения формы VBA (Макросы/Sub)
Посчитать процент заполнения формы VBA
Tunka-s Дата: Пятница, 20.11.2015, 13:47 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте.
Помогите пожалуйста усовершенствовать форму. В форме есть обязательные и необязательные поля. Обязательные поля отмечены восклицательным знаком (например). Форму должны заполнять разные люди. Хочется сделать счетчик при помощи VBA, какой процент обязательных полей уже заполнен и вывести рядом "персон", которые не заполнили еще свои обязательные поля.
Пока счетчик я сделала при помощи формулы, но хочется избавится от всей этой лишней информации - "ок", "нок". К тому же при помощи формулы получается вывести только одного ответственного за пропущенные поля, а хотелось бы всех. Пример приложен. Буду премного благодарна.
К сообщению приложен файл: ex1.xlsx (15.4 Kb)
 
Ответить
СообщениеЗдравствуйте.
Помогите пожалуйста усовершенствовать форму. В форме есть обязательные и необязательные поля. Обязательные поля отмечены восклицательным знаком (например). Форму должны заполнять разные люди. Хочется сделать счетчик при помощи VBA, какой процент обязательных полей уже заполнен и вывести рядом "персон", которые не заполнили еще свои обязательные поля.
Пока счетчик я сделала при помощи формулы, но хочется избавится от всей этой лишней информации - "ок", "нок". К тому же при помощи формулы получается вывести только одного ответственного за пропущенные поля, а хотелось бы всех. Пример приложен. Буду премного благодарна.
Автор - Tunka-s
Дата добавления - 20.11.2015 в 13:47
YouGreed Дата: Пятница, 20.11.2015, 17:43 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 589
Репутация: 123 ±
Замечаний: 0% ±

Excel 2010
Tunka-s, Можно попробовать формулой, это для того чтобы вытянуть "лентяев".
Код
=ИНДЕКС($A$3:$A$16;НАИБОЛЬШИЙ(($E$3:$E$16="nok")*(СТРОКА($E$3:$E$16)-2);СТРОКА(A1));)

Формула массива.
К сообщению приложен файл: 5094293.xlsx (15.2 Kb)
 
Ответить
СообщениеTunka-s, Можно попробовать формулой, это для того чтобы вытянуть "лентяев".
Код
=ИНДЕКС($A$3:$A$16;НАИБОЛЬШИЙ(($E$3:$E$16="nok")*(СТРОКА($E$3:$E$16)-2);СТРОКА(A1));)

Формула массива.
Автор - YouGreed
Дата добавления - 20.11.2015 в 17:43
Tunka-s Дата: Пятница, 20.11.2015, 18:18 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
YouGreed, спасибо большое. Если никто не поможет с макросом, буду использовать вашу формулу. :)
Интересно, нет ответа по VBA, это потому что задача такая не интересная или потому что пятница...
 
Ответить
СообщениеYouGreed, спасибо большое. Если никто не поможет с макросом, буду использовать вашу формулу. :)
Интересно, нет ответа по VBA, это потому что задача такая не интересная или потому что пятница...
Автор - Tunka-s
Дата добавления - 20.11.2015 в 18:18
Manyasha Дата: Пятница, 20.11.2015, 19:11 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Tunka-s, так подойдет?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    If Not Intersect(Target, Range("a3:c" & lr)) Is Nothing Then
        Dim kolTotal&, kolOk&
        kolTotal = lr - 2
        With CreateObject("Scripting.Dictionary"): .CompareMode = 1
            For i = 3 To lr
                If Cells(i, 3) = "" And Cells(i, 4) = "!" Then
                    If Trim(Cells(i, 1)) <> "" Then .Item(Trim(Cells(i, 1))) = .Item(Trim(Cells(i, 1))) + 1
                Else
                    kolOk = kolOk + 1
                End If
            Next i
            Range("f2", [f2].End(xlDown)).ClearContents
            Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)
        End With
        Range("e2") = kolOk / kolTotal
    End If
End Sub
[/vba]
% заполненных считала, как кол-во "ОК" разделить на общее кол-во полей, если не правильно, можете обратно на свою формулу поменять
К сообщению приложен файл: _5094293.xlsm (22.8 Kb)

ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеTunka-s, так подойдет?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    If Not Intersect(Target, Range("a3:c" & lr)) Is Nothing Then
        Dim kolTotal&, kolOk&
        kolTotal = lr - 2
        With CreateObject("Scripting.Dictionary"): .CompareMode = 1
            For i = 3 To lr
                If Cells(i, 3) = "" And Cells(i, 4) = "!" Then
                    If Trim(Cells(i, 1)) <> "" Then .Item(Trim(Cells(i, 1))) = .Item(Trim(Cells(i, 1))) + 1
                Else
                    kolOk = kolOk + 1
                End If
            Next i
            Range("f2", [f2].End(xlDown)).ClearContents
            Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)
        End With
        Range("e2") = kolOk / kolTotal
    End If
End Sub
[/vba]
% заполненных считала, как кол-во "ОК" разделить на общее кол-во полей, если не правильно, можете обратно на свою формулу поменять
Автор - Manyasha
Дата добавления - 20.11.2015 в 19:11
Roman777 Дата: Пятница, 20.11.2015, 20:52 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Manyasha, Добрый вечер. Если не трудно, поясните, пожалуйста, как работает у Вас кусочек:
[vba]
Код
Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)
[/vba]?

Много чего не знаю!!!!
 
Ответить
СообщениеManyasha, Добрый вечер. Если не трудно, поясните, пожалуйста, как работает у Вас кусочек:
[vba]
Код
Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)
[/vba]?
Автор - Roman777
Дата добавления - 20.11.2015 в 20:52
Manyasha Дата: Пятница, 20.11.2015, 21:11 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Roman777, .Count - считает кол-во ключей в словаре, прибавляем 1, т.к. вывод начинаем со 2-й строки, а не с 1-й.
Transpose - это функция листа ТРАНСП(). Без транспонирования ключи буду выводиться в строчку, т.е. если мы напишем просто
[vba]
Код
Range("f2:f" & .Count + 1) =.keys
[/vba] макрос выведет во все ячейки указанного диапазона только первый элемент полученного массива. :)

ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеRoman777, .Count - считает кол-во ключей в словаре, прибавляем 1, т.к. вывод начинаем со 2-й строки, а не с 1-й.
Transpose - это функция листа ТРАНСП(). Без транспонирования ключи буду выводиться в строчку, т.е. если мы напишем просто
[vba]
Код
Range("f2:f" & .Count + 1) =.keys
[/vba] макрос выведет во все ячейки указанного диапазона только первый элемент полученного массива. :)
Автор - Manyasha
Дата добавления - 20.11.2015 в 21:11
Tunka-s Дата: Понедельник, 23.11.2015, 11:50 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Manyasha, Все замечательно. Спасибо!
 
Ответить
СообщениеManyasha, Все замечательно. Спасибо!
Автор - Tunka-s
Дата добавления - 23.11.2015 в 11:50
Tunka-s Дата: Пятница, 27.11.2015, 16:46 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спустя неделю обнаружила проблему. Когда все все заполнили, вместо 100% и пустого списка "должников" появляется Run time error 13. Можно это исправить? Спасибо.
 
Ответить
СообщениеСпустя неделю обнаружила проблему. Когда все все заполнили, вместо 100% и пустого списка "должников" появляется Run time error 13. Можно это исправить? Спасибо.
Автор - Tunka-s
Дата добавления - 27.11.2015 в 16:46
Roman777 Дата: Пятница, 27.11.2015, 16:51 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Tunka-s,
[vba]
Код
If .Count <> 0 Then Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)
[/vba]
Вместо [vba]
Код
Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)
[/vba]

Много чего не знаю!!!!
 
Ответить
СообщениеTunka-s,
[vba]
Код
If .Count <> 0 Then Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)
[/vba]
Вместо [vba]
Код
Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)
[/vba]
Автор - Roman777
Дата добавления - 27.11.2015 в 16:51
Tunka-s Дата: Пятница, 27.11.2015, 17:24 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Thank you!!!Works!
 
Ответить
СообщениеThank you!!!Works!
Автор - Tunka-s
Дата добавления - 27.11.2015 в 17:24
Tunka-s Дата: Понедельник, 30.11.2015, 17:43 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Еще один вопрос. Как преобразовать эту строчку

Цитата Roman777,
If .Count <> 0 Then Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)


, чтобы она забирала элементы не из А столбца, а из Е например?

Спасибо заранее.


Сообщение отредактировал Tunka-s - Понедельник, 30.11.2015, 17:44
 
Ответить
СообщениеЕще один вопрос. Как преобразовать эту строчку

Цитата Roman777,
If .Count <> 0 Then Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)


, чтобы она забирала элементы не из А столбца, а из Е например?

Спасибо заранее.
Автор - Tunka-s
Дата добавления - 30.11.2015 в 17:43
Roman777 Дата: Понедельник, 30.11.2015, 18:02 | Сообщение № 12
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Tunka-s, у Вас значения задаются вовсе не в этой строке
Цитата Tunka-s, 30.11.2015 в 17:43, в сообщении № 11
If .Count <> 0 Then Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)

а в [vba]
Код
If Trim(Cells(i, 1)) <> "" Then .Item(Trim(Cells(i, 1))) = .Item(Trim(Cells(i, 1))) + 1
[/vba]
только сразу оговорочка... вообще код изначально предполагал, что значения в столбце 1 не повторяются... если у вас в столбце Е значения будут повторяться, то код надо будет весь переправлять...)

Много чего не знаю!!!!
 
Ответить
СообщениеTunka-s, у Вас значения задаются вовсе не в этой строке
Цитата Tunka-s, 30.11.2015 в 17:43, в сообщении № 11
If .Count <> 0 Then Range("f2:f" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)

а в [vba]
Код
If Trim(Cells(i, 1)) <> "" Then .Item(Trim(Cells(i, 1))) = .Item(Trim(Cells(i, 1))) + 1
[/vba]
только сразу оговорочка... вообще код изначально предполагал, что значения в столбце 1 не повторяются... если у вас в столбце Е значения будут повторяться, то код надо будет весь переправлять...)
Автор - Roman777
Дата добавления - 30.11.2015 в 18:02
Tunka-s Дата: Понедельник, 30.11.2015, 18:10 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Ох, замечательно! Эту строку я вообще убрала, потому что в начальном написании кода, % заполнения никогда не равен нулю. Так что я сделала все "в лоб". Теперь даже не знаю что делать. :) А данные конечно повторяются! Они и в начальном примере повторялись.

А этот IF, он же закрывается и выборка "лентяев" идет уже вне цикла. Что-то я совсем запуталась. Как же тогда область задается в цикле? Или область задаетыса с "WITH"?


Сообщение отредактировал Tunka-s - Понедельник, 30.11.2015, 18:22
 
Ответить
СообщениеОх, замечательно! Эту строку я вообще убрала, потому что в начальном написании кода, % заполнения никогда не равен нулю. Так что я сделала все "в лоб". Теперь даже не знаю что делать. :) А данные конечно повторяются! Они и в начальном примере повторялись.

А этот IF, он же закрывается и выборка "лентяев" идет уже вне цикла. Что-то я совсем запуталась. Как же тогда область задается в цикле? Или область задаетыса с "WITH"?
Автор - Tunka-s
Дата добавления - 30.11.2015 в 18:10
Manyasha Дата: Понедельник, 30.11.2015, 18:25 | Сообщение № 14
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Tunka-s, переместился только столбец А или вся таблица?
если только 1 столбец, то поправить 1 строчку, как написал Roman777
[vba]
Код
If Trim(Cells(i, "e")) <> "" Then .Item(Trim(Cells(i, "e"))) = .Item(Trim(Cells(i, "e"))) + 1
[/vba]
ну и вывод процентов теперь наверное не в Е2, а где-нибудь еще (просто буковку е заменить на нужную)[vba]
Код
Range("e2") = kolOk / kolTotal
[/vba]
Если таблица поменялась, выложите новый пример.

Роман, при создании словаря, мы ему сказали сравнивать текст ключей
[vba]
Код
With CreateObject("Scripting.Dictionary"): .CompareMode = 1'вот тут
[/vba]
так что, повторов не будет, выводятся только уникальные значения. :)

ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеTunka-s, переместился только столбец А или вся таблица?
если только 1 столбец, то поправить 1 строчку, как написал Roman777
[vba]
Код
If Trim(Cells(i, "e")) <> "" Then .Item(Trim(Cells(i, "e"))) = .Item(Trim(Cells(i, "e"))) + 1
[/vba]
ну и вывод процентов теперь наверное не в Е2, а где-нибудь еще (просто буковку е заменить на нужную)[vba]
Код
Range("e2") = kolOk / kolTotal
[/vba]
Если таблица поменялась, выложите новый пример.

Роман, при создании словаря, мы ему сказали сравнивать текст ключей
[vba]
Код
With CreateObject("Scripting.Dictionary"): .CompareMode = 1'вот тут
[/vba]
так что, повторов не будет, выводятся только уникальные значения. :)
Автор - Manyasha
Дата добавления - 30.11.2015 в 18:25
Tunka-s Дата: Понедельник, 30.11.2015, 18:35 | Сообщение № 15
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Таблица не поменялась по сути своей, она сдвинулась и добавились еще три столбца, но они не функциональны с точки зрения данной задачи. Я уже все цифры и буквы поменяла, проценты считаются отлично. Не выводятся должности только, потому что не могу задать столбец Е!

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    lr = Cells(Rows.Count, 2).End(xlUp).Row
    If Not Intersect(Target, Range("e8:g" & lr)) Is Nothing Then
        Dim kolTotal&, kolOk&
        'kolTotal = lr - 7
         With CreateObject("Scripting.Dictionary"): .CompareMode = 1
            For i = 8 To lr
            
            If Cells(i, 4) = "!" Then
            kolTotal = kolTotal + 1
            
            End If
                'If Cells(i, 7) = "" And Cells(i, 4) = "!" Then
                If Trim(Cells(i, 7)) <> "" Then
                    '.Item(Trim(Cells(i, 7))) = .Item(Trim(Cells(i, 7))) + 1
                'else
                    kolOk = kolOk + 1
                End If
            Next i
            Range("a2", [a2].End(xlDown)).ClearContents
            If .Count <> 0 Then Range("a2:a" & .Count + 1) = Application.WorksheetFunction.Transpose(Range(.keys))
                End With
       ' Range("b2") = kolOk
       ' Range("c2") = kolTotal
        Range("b2") = kolOk / kolTotal
           End If
End Sub
[/vba]


Сообщение отредактировал Tunka-s - Понедельник, 30.11.2015, 18:36
 
Ответить
СообщениеТаблица не поменялась по сути своей, она сдвинулась и добавились еще три столбца, но они не функциональны с точки зрения данной задачи. Я уже все цифры и буквы поменяла, проценты считаются отлично. Не выводятся должности только, потому что не могу задать столбец Е!

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    lr = Cells(Rows.Count, 2).End(xlUp).Row
    If Not Intersect(Target, Range("e8:g" & lr)) Is Nothing Then
        Dim kolTotal&, kolOk&
        'kolTotal = lr - 7
         With CreateObject("Scripting.Dictionary"): .CompareMode = 1
            For i = 8 To lr
            
            If Cells(i, 4) = "!" Then
            kolTotal = kolTotal + 1
            
            End If
                'If Cells(i, 7) = "" And Cells(i, 4) = "!" Then
                If Trim(Cells(i, 7)) <> "" Then
                    '.Item(Trim(Cells(i, 7))) = .Item(Trim(Cells(i, 7))) + 1
                'else
                    kolOk = kolOk + 1
                End If
            Next i
            Range("a2", [a2].End(xlDown)).ClearContents
            If .Count <> 0 Then Range("a2:a" & .Count + 1) = Application.WorksheetFunction.Transpose(Range(.keys))
                End With
       ' Range("b2") = kolOk
       ' Range("c2") = kolTotal
        Range("b2") = kolOk / kolTotal
           End If
End Sub
[/vba]
Автор - Tunka-s
Дата добавления - 30.11.2015 в 18:35
Tunka-s Дата: Понедельник, 30.11.2015, 18:40 | Сообщение № 16
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Т.е. 1 уже поменяла на 7, (ну или А на Е), но все равно ничего не выводится.

Пример приложен.
К сообщению приложен файл: 3810105.xlsx (16.4 Kb)
 
Ответить
СообщениеТ.е. 1 уже поменяла на 7, (ну или А на Е), но все равно ничего не выводится.

Пример приложен.
Автор - Tunka-s
Дата добавления - 30.11.2015 в 18:40
Manyasha Дата: Понедельник, 30.11.2015, 18:53 | Сообщение № 17
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Tunka-s, проверяйте
строчки
[vba]
Код
                If Trim(Cells(i, 7)) <> "" Then
                    '.Item(Trim(Cells(i, 7))) = .Item(Trim(Cells(i, 7))) + 1
[/vba]отвечают за заполнение массива для столбца А, ее не нужно убирать
[p.s.]Если интересно, про словари тут можно почитать.
Все очень доступно описано[/p.s.]
К сообщению приложен файл: 3810105-1.xlsm (24.0 Kb)

ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеTunka-s, проверяйте
строчки
[vba]
Код
                If Trim(Cells(i, 7)) <> "" Then
                    '.Item(Trim(Cells(i, 7))) = .Item(Trim(Cells(i, 7))) + 1
[/vba]отвечают за заполнение массива для столбца А, ее не нужно убирать
[p.s.]Если интересно, про словари тут можно почитать.
Все очень доступно описано[/p.s.]
Автор - Manyasha
Дата добавления - 30.11.2015 в 18:53
Tunka-s Дата: Понедельник, 30.11.2015, 19:07 | Сообщение № 18
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Кажется разобралась. Всем большое спасибо за помощь!
 
Ответить
СообщениеКажется разобралась. Всем большое спасибо за помощь!
Автор - Tunka-s
Дата добавления - 30.11.2015 в 19:07
Tunka-s Дата: Понедельник, 30.11.2015, 19:08 | Сообщение № 19
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спасибо Manyasha, да я уже увидела, что многовато убрала! :)
 
Ответить
СообщениеСпасибо Manyasha, да я уже увидела, что многовато убрала! :)
Автор - Tunka-s
Дата добавления - 30.11.2015 в 19:08
Tunka-s Дата: Понедельник, 30.11.2015, 19:20 | Сообщение № 20
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 124
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Все равно не понимаю, как считаются проценты у вас. lr - это количество строк, так? kolTotal = lr - 2, т.е. кол-во тотал, это не количество обязательных полей, а количество всех полей? Переношу ваш код в основной файл и опять у меня 33% при нулевом заполнении.
 
Ответить
СообщениеВсе равно не понимаю, как считаются проценты у вас. lr - это количество строк, так? kolTotal = lr - 2, т.е. кол-во тотал, это не количество обязательных полей, а количество всех полей? Переношу ваш код в основной файл и опять у меня 33% при нулевом заполнении.
Автор - Tunka-s
Дата добавления - 30.11.2015 в 19:20
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Посчитать процент заполнения формы VBA (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!