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

Страницы: 1
Создание аббревиатуры, Извлечение первых букв набора слов в ячейке
 
#
12.11.2017 18:50:13
Всем доброго времени суток. Друзья необходима помощь, сформировал формулу:

Код
=ЛЕВСИМВ(A1;1)&ПРОПНАЧ(ПСТР(A1;ПОИСК(" ";A1)+1;1))&ПРОПНАЧ(ПСТР(A1;ПОИСК(" ";A1;ПОИСК(" ";A1)+1)+1;1))&ПРОПНАЧ(ПСТР(A1;ПОИСК(" ";A1;ПОИСК(" ";A1;ПОИСК(" ";A1)+1)+1)+1;1))


Которая создает аббревиатуру по первым буквам каждого слова введенного в одну ячейку, слова разделены пробелами. Данная формула работает только с 4-мя словами.
Конечно можно ее увеличить до n-го количества слов, но она получится громоздкой. Подскажите может как-то макросом можно сделать
 
Перейти    
Отбор и подсчет количества уникальных значений по нескольким условиям, Отбор и подсчет количества уникальных значений по нескольким условиям
 
#
13.08.2017 13:34:48
Доброго дня, всем участникам форума. Столкнулся с проблемкой, есть код:

Код
Sub test2()
Dim d, a, i As Long
date3 = InputBox("Введите год")
If IsNumeric(date3) Then date3 = Year(DateSerial(CInt(date3), 1, 1)) Else Exit Sub
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = 1
a = ActiveSheet.Cells(2, 2).CurrentRegion.Value
For i = 2 To UBound(a)

  If Not d.exists(a(i, 2)) Then d(a(i, 2)) = 0
  If Year(a(i, 3)) = date3 Then d(a(i, 2)) = d(a(i, 2)) + 1
Next i
ActiveSheet.Cells(1, 8).Resize(1, d.Count) = d.keys
ActiveSheet.Cells(2, 8).Resize(1, d.Count) = d.items
End Sub


По этому коду макрос формирует отчет находящийся в диапазоне H1:K2, но задача усложнилась тем, что в исходной таблице добавился стобец с агентами. Теперь необходимо сформировать отчет по форме как в диапазоне G13:K16. Прошу Вашей помощи разобраться как это сделать. Пример прилагаю
Изменено: garnik - 13.08.2017 14:07:45
 
Перейти    
Текст и рисунок разместить на CommandButton в UserForm
 
#
28.07.2017 17:24:03
Здравствуйте, уважаемые форумчане. Снова прошу у Вас помощи. Подскажите необходимо на кнопочке CommandButton вставить картинку слева по центру и наименование кнопки текстом, как показано на рисунке во вложении. Картинку в кнопочку вставляю, а вот с текстом беда, не могу сделать одновременно и текст и картинку. Пробовал вставлять текст как Label, но тогда при нахождении курсора мыши на тексте кнопки не происходит ее активация
 
Перейти    
Извлечение уникальных значений и подсчет их количества по условию
 
#
07.06.2017 20:01:20
Добрый вечер, уважаемые друзья. Собрал макрос, который извлекает из диапазона А1:А90 уникальные значения в диапазон Е1:Е5.
Прошу помочь Вас в следующем, не могу сообразить как выполнить:
1. Необходимо чтобы извлечение проводилось со всего диапазона непустых ячеек в столбце А.
2. Уникальные значения выводились не в столбик диапазона Е1:Е5, а в строку диапазон H1:L1, но L1 должна быть переменной, так как уникальных значений может быть больше.

Код и пример прилагаю:

Код
Sub test()
Dim myRange As Range, myCell As Range, myCollection As New Collection, _
myElement As Variant, i As Long
Set myRange = Range("A1:A90")
On Error Resume Next
For Each myCell In myRange
myCollection.Add CStr(myCell.Value), CStr(myCell.Value)
Next myCell
On Error GoTo 0
For Each myElement In myCollection
i = i + 1
Cells(i, 5) = myElement
Next myElement
date3 = InputBox("Введите год")
For k = 8 To 12
For j = 1 To 90
If Cells(1, k) = Cells(j, 1) Then
If date3 = CStr(Year(Cells(j, 2))) Then
Cells(2, k) = Cells(2, k) + 1
End If
End If
Next j
Next k
End Sub
Изменено: garnik - 07.06.2017 20:08:54
 
Перейти    
Извлечение из ячейки части текста и формирование нового текста
 
#
23.05.2017 13:07:37
Добрый день, уважаемые друзья. Есть задача, которую я решил с помощью формул (см. Пример), но моих знаний VBA не хватает для того чтобы исключить формулы в ячейках. Прошу у Вас помощи. По условию ячейки А1 и В1 даются, необходимо получить результат, который находится в ячейке Е1. Ячейки С1 и D1 я делал промежуточными дабы формула не была громоздкой. Заранее благодарю за помощь.
 
Перейти    
Ошибка при присвоении значения ячейке: run time error 13
 
#
21.12.2016 22:45:07
Всем доброго времени суток, есть код в котором выдает ошибку на одной строке. Не могу понять в чем проблема. Подскажите пожалуйста. В строке ThisWorkbook.Sheets(Sheet).Cells(j, z) = 1 выдает run time error 13


Код
Private Sub CommandButton1_Click()
Dim i As Long
Dim j As Integer, z As Integer
Dim Sheet As String
Dim lAllCnt As Long 'кол-во итераций
    Const lMaxQuad As Long = 20 'сколько квадратов выводить
    lAllCnt = 10000
Sheet = "Заявка на " & UserForm2.ComboBox1 & " квартал " & UserForm2.ComboBox2 & " года."
Sheets.Add After:=Sheets(Sheets.Count)
   ActiveSheet.Name = Sheet
 Call add_sheets
 Call proverka_mesyacev
For i = 2 To lAllCnt
Application.StatusBar = "Выполнено: " & Int(100 * i / lAllCnt) & "%" & String(CLng(lMaxQuad * i / lAllCnt), ChrW(9632)) & String(lMaxQuad - CLng(lMaxQuad * i / lAllCnt), ChrW(9633))
        DoEvents
If ThisWorkbook.Sheets("БД работников ЦРМО").Cells(i, 9) <> " -" Then
'If ThisWorkbook.Sheets("БД работников ЦРМО").Cells(i, 9) = "" Then
'Exit For
'End If
If CLng(UserForm2.ComboBox2) = DatePart("yyyy", ThisWorkbook.Sheets("БД работников ЦРМО").Cells(i, 9)) Then
            If CLng(UserForm2.ComboBox1) = DatePart("q", ThisWorkbook.Sheets("БД работников ЦРМО").Cells(i, 9)) Then
            For j = 4 To 6
            If ThisWorkbook.Sheets(Sheet).Cells(j, 2) = ThisWorkbook.Sheets("БД работников ЦРМО").Cells(i, 15) Then
            For z = 4 To 6
            If Month(ThisWorkbook.Sheets("БД работников ЦРМО").Cells(i, 9)) = Month(ThisWorkbook.Sheets(Sheet).Cells(2, z)) Then
            ThisWorkbook.Sheets(Sheet).Cells(j, z) = ThisWorkbook.Sheets(Sheet).Cells(j, z) + 1
            Exit For
            End If
            Next z
            Exit For
            End If
            Next j
            If j = 7 Then
            For j = 4 To 6
            If ThisWorkbook.Sheets(Sheet).Cells(j, 2) = "" Then
            ThisWorkbook.Sheets(Sheet).Cells(j, 2) = ThisWorkbook.Sheets("БД работников ЦРМО").Cells(i, 15)
            For z = 4 To 6
            If Month(ThisWorkbook.Sheets("БД работников ЦРМО").Cells(i, 9)) = Month(ThisWorkbook.Sheets(Sheet).Cells(2, z)) Then
           ThisWorkbook.Sheets(Sheet).Cells(j, z) = 1
            Exit For
            End If
            Next z
            Exit For
            End If
            Next j
            End If
            End If
        End If
End If
Next i
Application.StatusBar = False
End Sub
Изменено: garnik - 21.12.2016 23:34:32
 
Перейти    
Отбор данных по дате через форму и combobox
 
#
17.12.2016 15:14:37
Всем, доброго дня. Друзья подскажите, пожалуйста, есть таблица с датами, к каждой дате есть определенное значение в соседней ячейке. Создал форму в форме добавил два combobox, в одном выбирается квартал, во втором год. Макрос при проверке столбца с датами должен сравнивать со значениями с комбобокса и при совпадении переносить значение ячейки соответствующей даты. Вопрос в следующем, я понимаю что значения с комбобокса макрос не воспринимает как дату, подскажите как подправить код.
 
Перейти    
Формат ячейки после работы макроса
 
#
16.12.2016 13:45:52
Добрый день, друзья. Столкнулся вот с такой проблемой есть форма с textbox в который вводится дата, эта дата должна по нажатию кнопочки в форме переносится в ячейку А1, вид дата должна иметь такой как в ячейке А2. формат ячеек выставлял одинаковый, но после того как с текстбокса переносится дата в ячейку А1, формат отображения изменяется как указано в примере. В текстбокс надо вводить дату в формате dd.mm.yyyy.
 
Перейти    
Подсчет уникальных значений после применения фильтра
 
#
22.10.2015 20:56:33
Привет, всем, великие умы подскажите, пожалуйста, как организовать подсчет количества уникальных значений видимых ячеек после применения фильтра
 
Перейти    
Страницы: 1
Наверх