Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 След.
Как автоматически создать новую строку около каждой ячейки с новым ФИО.
 
Если я правильно понял, то подобная задача с помощью записи макросов достаточно легко реализуется.
Встаем на нужную ячейку и выполняем макрос. Можно назначить горячую клавишу для выполнения.
Код
Sub ЖелтыйФИО()

    Selection.Insert
    Cells(Selection.Row, 1) = Cells(Selection.Row - 1, 1)
    Cells(Selection.Row, 1).Interior.Color = vbYellow
    
End Sub
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Запретить переход на следующий TextBox при определенном условии, Не получается сохранить фокус с помощью SetFocus и события AfterUpdate
 
Юрий М, работает, большое спасибо!
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Запретить переход на следующий TextBox при определенном условии, Не получается сохранить фокус с помощью SetFocus и события AfterUpdate
 
Здравствуйте, уважаемый эксперты!
Помогите пожалуйста решить задачу.
В форме имеются несколько TextBox, которые последовательно заполняются.
Не получается реализовать следующее:
Если пользователь ввел "0" и переходит на следующее поле, то вылетает соответствующий MsgBox, некорректный TextBox очищается, а фокус остается на месте.
Код
Private Sub Количество_AfterUpdate()
    If Количество <= 0 Then
        MsgBox "Введите число больше нуля"
        Количество = ""
        Количество.SetFocus
        Exit Sub
    End If
End Sub
Такой подход не срабатывает, фокус все равно переходит на следующий TetxtBox.
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
макрос смены значения в выпадающем списке и сохранение результатов в jpeg с определенным именем
 
Sanja, если два раза подряд нажимаю, то вылетает ошибка:
Run-time error '1004':
Метод CopyPicture из класса Range завершен неверно.

Хм...на самом деле через раз ошибка. Не знаете в чем может быть загвоздка?
Изменено: Valo - 3 Май 2019 18:28:02
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
макрос смены значения в выпадающем списке и сохранение результатов в jpeg с определенным именем
 
Sanja, если часто выполнять макрос, то периодически выскакивает ошибка при выполнении.
Я вот так сделал, вроде ошибок не вылетает.
Код
Sub SavePicture()

    Dim i As Integer
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    i = 4
    Do While Worksheets("Проекты").Cells(i, 1) <> ""
        Worksheets("КП").Cells(3, 2) = Worksheets("Проекты").Cells(i, 1)
        Worksheets("КП").Range("B6:E15").CopyPicture
        With Worksheets("КП").ChartObjects.Add(0, 0, Worksheets("КП").Range("B6:E15").Width, Worksheets("КП").Range("B6:E15").Height).Chart
                .ChartArea.Border.LineStyle = 0
                .Parent.Select
                .Paste
                .Export Filename:=ThisWorkbook.Path & "\" & Cells(4, 2) & ".jpeg", FilterName:="JPEG"
                .Parent.Delete
        End With
        i = i + 1
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Изменено: Valo - 3 Май 2019 18:15:53
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Вытащить данные по нескольким критериям, Подскажите пожалуйста решение, нужно вытащить данные по нескольким критериям и вставить их в табличку один за другим.
 
Подобные задачи достаточно несложно решаются макросом.
Если такое решение вам подходит, то надо быть готовым к тому, что в коде в любом случае придется разбираться и доводить его до ума.
Код
Sub Оценка()

    Dim СтрокаОтчет As Long
    Dim СтрокаОценка As Long
    Dim СтолбецОтчет As Integer
    
    Dim ЛистОтчет As Worksheet
    Dim ЛистОценок As Worksheet
    
    Dim НайденаДолжность As Boolean
    Dim НайденаОценка As Boolean
    
    Set ЛистОтчет = Worksheets("ППР_КПЭ_5+")
    СтрокаОтчет = 4 'Данные в отчетном листе заполняются начиная с 4 строки
    
    'Очистка заполненных данных в листах с оценками
    For Each ЛистОценок In ThisWorkbook.Worksheets
        If ЛистОценок.Name <> "ППР_КПЭ_5+" Then
            Range(ЛистОценок.Rows("5:5"), ЛистОценок.Rows("5:5").End(xlDown)).ClearContents
        End If
    Next
    
    Do Until ЛистОтчет.Cells(СтрокаОтчет, 5) = ""
            НайденаДолжность = True
        Select Case ЛистОтчет.Cells(СтрокаОтчет, 5)
            Case "2"
                Set ЛистОценок = Worksheets("Директора ССП")
            Case "3"
                Set ЛистОценок = Worksheets("Зам Директора ССП")
            Case "2.1"
                Set ЛистОценок = Worksheets("Директора Филиалов")
            Case "3.1"
                Set ЛистОценок = Worksheets("Зам Директора Филиала")
            Case Else
                НайденаДолжность = False
            End Select
            If НайденаДолжность = True Then
                    НайденаОценка = True
                Select Case ЛистОтчет.Cells(СтрокаОтчет, 9)
                    Case "B", "В"
                        СтолбецОтчет = 1
                        СтрокаОценка = Application.WorksheetFunction.CountA(ЛистОценок.Range("A:A")) + 3
                    Case "C", "С"
                        СтолбецОтчет = 6
                        СтрокаОценка = Application.WorksheetFunction.CountA(ЛистОценок.Range("F:F")) + 3
                    Case "A", "А"
                        СтолбецОтчет = 11
                        СтрокаОценка = Application.WorksheetFunction.CountA(ЛистОценок.Range("K:K")) + 3
                    Case "D"
                        СтолбецОтчет = 16
                        СтрокаОценка = Application.WorksheetFunction.CountA(ЛистОценок.Range("K:K")) + 3
                    Case Else
                        НайденаОценка = False
                End Select
                    If НайденаОценка = True Then
                        ЛистОценок.Cells(СтрокаОценка, СтолбецОтчет) = ЛистОтчет.Cells(СтрокаОтчет, 2)
                        ЛистОценок.Cells(СтрокаОценка, СтолбецОтчет + 1) = ЛистОтчет.Cells(СтрокаОтчет, 3)
                        ЛистОценок.Cells(СтрокаОценка, СтолбецОтчет + 2) = ЛистОтчет.Cells(СтрокаОтчет, 4)
                        ЛистОценок.Cells(СтрокаОценка, СтолбецОтчет + 3) = ЛистОтчет.Cells(СтрокаОтчет, 9)
                        If ЛистОтчет.Cells(СтрокаОтчет, 8) > 1.1 Then
                            СтрокаОценка = Application.WorksheetFunction.CountA(ЛистОценок.Range("U:U")) + 3
                            ЛистОценок.Cells(СтрокаОценка, 21) = ЛистОтчет.Cells(СтрокаОтчет, 2)
                            ЛистОценок.Cells(СтрокаОценка, 22) = ЛистОтчет.Cells(СтрокаОтчет, 3)
                            ЛистОценок.Cells(СтрокаОценка, 23) = ЛистОтчет.Cells(СтрокаОтчет, 4)
                            ЛистОценок.Cells(СтрокаОценка, 24) = ЛистОтчет.Cells(СтрокаОтчет, 9)
                        End If
                    End If
            End If
        СтрокаОтчет = СтрокаОтчет + 1
    Loop
    
End Sub
Изменено: Valo - 21 Апр 2019 16:57:44
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Помогите удалить квадрат в таблице!, Товарищи помогите пожалуйста удалить квадратик с вводом текста в таблице.
 
Включите режим конструктора, после этого правая кнопка мыши заработает.
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Поиск занчения в файле и запись в ячейку.
 
encomos, по примеру составил макрос, может не самый оптимальный, но с задачей справляется.
Однако надо понимать, что с реальными файлами ситуация может пойти не так радостно, в первую очередь из разнородной организации данных в файлах и различных наименований одного и того же объекта.
Поэтому, в любом случае придется самостоятельно во всем этом деле разбираться и доводить до ума.
Код
Sub Отчет()

    Dim ПоследняяСтрокаОбщий As Long
    Dim ПоследняяСтрокаОтчет As Long
    Dim ПоследнийСтолбец As Long
    Dim СтрокаОбщий As Long
    Dim СтрокаОтчет As Long
    Dim Столбец As Long
    
    Dim ПутьКФайлу As String
    Dim НазваниеФайла As String
    
    Dim ОбщийФайл As Worksheet
    Dim Отчет As Worksheet
    
    Set ОбщийФайл = ThisWorkbook.Worksheets(1)
    ПутьКФайлу = ThisWorkbook.Path & "\"
    
    ПоследнийСтолбец = ОбщийФайл.Cells.SpecialCells(xlLastCell).Column
    ПоследняяСтрокаОбщий = ОбщийФайл.Cells.SpecialCells(xlLastCell).Row
    
    For Столбец = 3 To ПоследнийСтолбец
        'Название файла формируюется из месяца и года в заголовках начиная с третьего столбца. Все названия отчетных файло должны быть вид "ммгггг"
        'Все отчетные файлы находятся в той же папке, что и общий файл
        НазваниеФайла = Format(DatePart("m", Cells(1, Столбец)), "00") & DatePart("yyyy", Cells(1, Столбец))
        НазваниеФайла = ПутьКФайлу & НазваниеФайла
        If Dir(НазваниеФайла & "*") <> "" Then
            НазваниеФайла = Dir(НазваниеФайла & "*")
            Set Отчет = Workbooks.Open(ПутьКФайлу & НазваниеФайла).Worksheets(1)
            ПоследняяСтрокаОтчет = Отчет.Cells.SpecialCells(xlLastCell).Row
            СтрокаОбщий = 2
            Do While СтрокаОбщий <> ПоследняяСтрокаОбщий + 1
                СтрокаОтчет = 2
                Do While СтрокаОтчет <> ПоследняяСтрокаОтчет + 1
                    'Наименование в общем и отчетном файлах начинается со второй строки первого столбца
                    If Отчет.Cells(СтрокаОтчет, 1) = ОбщийФайл.Cells(СтрокаОбщий, 1) Then
                        'Суммы в отчетных файлах находятся в третьем столбце
                        ОбщийФайл.Cells(СтрокаОбщий, Столбец) = Отчет.Cells(СтрокаОтчет, 3)
                        СтрокаОтчет = СтрокаОтчет + 1
                        Exit Do
                    End If
                    СтрокаОтчет = СтрокаОтчет + 1
                Loop
                СтрокаОбщий = СтрокаОбщий + 1
            Loop
            ActiveWorkbook.Close (False)
        End If
    Next

End Sub
Изменено: Valo - 18 Апр 2019 14:40:48
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Поиск занчения в файле и запись в ячейку.
 
encomos, вам намекают, что с картинками работать невозможно, надо выкладывать файлы примеров.
С ходу бросается в глаза, что в одной таблице - Шишов, а в другой - Шишов Александр Вадимович. И что-то мне подсказывает, что на идентичные названия одной сущности нет даже намека. Поверьте, при таком подходе будет очень сложно работать.
Изменено: Valo - 17 Апр 2019 23:54:36
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
несколько данных в одну строку
 
Используя свойство selected.
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
[ Закрыто] Сбор данных, Собрать данные с листов и занести их на отдельный лист.
 
Цитата
Sheriff написал:
то могу накидать книгу с листами для образца что нужно и из чего
Да и без примера не обойтись.
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Преобразование табличных данных в строчные
 
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
чтобы копировалось, а не копировалось +1 при размножении ячейки
 
Artsem K, может макросом будет нормально?
Его можно поместить в личную книгу макросов, чтобы он был доступен для любой книги и назначить сочетание клавиш для его выполнения.
Код
Sub Заполнить()
    Dim Строка As Long
    If Selection = "" Then Exit Sub
    Строка = Cells.SpecialCells(xlCellTypeLastCell).Row
    Selection.AutoFill Destination:=Range("A" & Selection.Row & ":A" & Строка), Type:=xlFillCopy
End Sub
Изменено: Valo - 17 Апр 2019 18:54:10
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Макрос для подстановки формулы из ячейки
 
KEKIs, строку использовать ту,  которая в данный момент активна.
Проще всего сначала написать формулу в нужной ячейке, посмотреть как она будет работать при протягивании, а затем эту формулу скопировать в диспетчер имен.
Изменено: Valo - 17 Апр 2019 18:01:10
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Макрос для подстановки формулы из ячейки
 
Цитата
KEKIs написал:
(У Вани нет сделок)
Но 1% от общей суммы же надо считать?

Опишите еще как для бухгалтера считается зарплата.
Изменено: Valo - 17 Апр 2019 17:57:48
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
чтобы копировалось, а не копировалось +1 при размножении ячейки
 
Если тянуть с нажатой клавишей Ctrl, то ячейки скопируются.
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Изменение даты циклом
 
Chueoko, в сообщении #11 все же работает :sceptic:  
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Как скопировать значение формулы в ячейку по условию
 
С помощью worksheet_change наверное можно чего-то подобного добиться. Для этого файла, я бы так сделал.
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Изменение даты циклом
 
Chueoko,чуть поправил формулу, теперь можно с любой строки начинать :) .
Код
=ЕСЛИ(СЧЁТЕСЛИ(A$2:A3;A3)=6;A3+1;A3)
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Макрос для подстановки формулы из ячейки
 
KEKIs, формулы писал в обычном формате.
Допустим я хочу добавить формулу расчета зарплаты для должности - Директор:
1. На листе Формулы добавляю Директор в столбец Должность
2. Пишу название формулы для ОПН - Дир_ОПН
3. Пишу название формулы для ОПН - Дир_ОДП
4. Захожу в диспетчер имен и создаю формулы расчета с именем Дир_ОПН
5. Сама формула допустим будет выглядеть так:
Код
=0,5*СУММ('Отчетп о сделкам'!$B:$B)
Обязательно закрепляем столбцы.

5. Захожу в диспетчер имен и создаю формулы расчета с именем Дир_ОДП
6. Сама формула допустим будет выглядеть так:
Код
=0,3*СУММ('Отчетп о сделкам'!$B:$B)
Обязательно закрепляем столбцы.

6. Пишу на листе Файл ЗП должность Директор и протягиваю формулы.

Формулы Выч_ОП и Выч_ОДП работают так:
С помощью ВПР ищется название формулы в таблице на листе Формулы для соответствующей должности. Выч_ОП берет название из 2 столбца, Выч_ОДП из 3 столбца. Далее с помощью функции Вычислить - происходит расчет формулы с этим названием в диспетчере имен.
Изменено: Valo - 17 Апр 2019 17:47:35
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Макрос для подстановки формулы из ячейки
 
KEKIs,не знаю, актуально ли еще, но можно попробовать через диспетчер имен решить задачу.
Прикладываю, как бы я реализовал этот файл.
Хоть макросы я здесь и не использую, но файл все равно должен быть в формате .xlsm.
Изменено: Valo - 16 Апр 2019 23:56:26
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Функция Суммесли. Неправильное суммирование
 
Дело в том, что Excel рассматривает данные штриходы как числа, а не как текст и при сравнении округляет до определенного числа знаков.
Отсюда и неправильный счет.
Надо дать понять Exel явным образом, что мы ищем текст.
Код
=СУММЕСЛИ(Лист2!A:A;Лист1!A4&"*";Лист2!B:B)
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Написание в VBA кода для переноса части и редактирования части содержимого одной ячейки в другие ячейки, Написание в VBA кода для переноса части и редактирования части содержимого одной ячейки в другие ячейки
 
Вот такой вариант могу предложить.
Код
Sub Формат()

    Dim Строка As Long
    Dim ПоследняяСтрока As Long
    
    ПоследняяСтрока = Cells.SpecialCells(xlCellTypeLastCell).Row
    Строка = 1
    For Строка = 1 To ПоследняяСтрока
        If Cells(Строка, 2) <> "" Then
            If Cells(Строка, 2) Like "Карта*" Then
                Cells(Строка + 1, 1).FormulaR1C1 = "=SUBSTITUTE(MID(R[-1]C[1],8,22),"" "","""")"
                Cells(Строка + 1, 1) = Cells(Строка + 1, 1)
            Else
                If Cells(Строка + 1, 2) <> "" Then Cells(Строка + 1, 1) = Cells(Строка, 1)
            End If
        End If
    Next

End Sub
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
как выбрать определенные данные для отображения в сводной диаграмме
 
С дополнительным столбцом в таблице-источнике что-то похожее получается.
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
как выбрать определенные данные для отображения в сводной диаграмме
 
Вы попробовали поставить фильтр в последнем файле, который я приложил? :)
Так а зачем вам Д1 и Д2, скройте эти листы. Все сводные на главной же странице.
Изменено: Valo - 16 Апр 2019 18:27:26
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
как выбрать определенные данные для отображения в сводной диаграмме
 
Ну все равно по моему без вспомогательных сводных не обойтись.
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
VBA. Разность двух массивов
 
Ну тут вроде через запись макроса можно неплохой результат получить  :sceptic:
Код
Worksheets("Лист3").Range("A2:D5").FormulaArray = "=Лист1!RC:R[3]C[3]-Лист2!RC:R[3]C[3]"
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
как выбрать определенные данные для отображения в сводной диаграмме
 
Я был сделал так.
  1. В качестве источника данных для сводных таблиц использовал бы умную таблицу, чтобы не приходилось каждый раз обновлять данные.
  2. Построил бы отдельные друг от друг сводные диаграммы.
  3. Переместил бы сами диаграммы на отдельный лист.
В итоге как-то так:
Изменено: Valo - 16 Апр 2019 17:56:55
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Макрос сохранения последнего видимого листа в отдельный файл "CSV (разделители - запятые)"
 
Получилось?
Код
Sub CSV()
     
    Dim WS As Worksheet
    Dim LastWS As Long
    Dim Name As String
    
    For Each WS In ActiveWorkbook.Worksheets
        If WS.Visible = True Then LastWS = WS.Index
    Next

    Name = ActiveWorkbook.Path & "\" & "Otchet_" & Replace(ActiveWorkbook.Name, ".xlsx", ".csv")
    
    ActiveWorkbook.Worksheets(LastWS).Copy
    ActiveWorkbook.SaveAs Filename:=Name, FileFormat:=xlCSV
    ActiveWorkbook.Close False
     
End Sub
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Присвоение типа товаров, Как сделать
 
Мне нравится с помощью умных таблиц и диспетчера имен такие задачи решать, так как при пополнении базы отпадает задача в обновлении диапазона списков.
А вообще есть замечательный видеоролик на эту тему  :) .
Изменено: Valo - 16 Апр 2019 17:42:45
Наша суть отражается в наших повторяющихся действиях. Отсюда следует, что совершенство есть не действие, а привычка. Аристотель.
Страницы: 1 2 3 След.
Наверх