Страницы: 1
RSS
Журнал учёта ., Журнал учёта , с переход на новую строку при заполнении текущей
 

Добрый день. Имеется книга Excel 2010, с четырьмя листами «Договор» , «Данные», «Акт» , «Журнал учёта» . Заполнение данных в договор и акт осуществляется с  листа данные , после заполнения печатаются 2 договора и 1 акт и происходит сохранение документа (печать и сохранения реализованы путём создания макроса , который привязан к кнопке .

  Поставлена задача реализовать ведение журнала учёта , т.е. необходимо , чтоб при нажатии кнопки «печать и сохранить» в журнал заносились данные текущего договора согласно таблице и переход на следующую строку для занесения данных следующего договора и т. д. Помогите пожалуйста реализовать поставленную задачу . Файл прикладываю к вопросу.Пример.xlsm (98.68 КБ)

Изменено: Сергей Фенев - 04.07.2022 09:10:18
 
Добрый день, если правильно понял, вариант:
Вредить легко, помогать трудно.
 
Спасибо огромное , отчёт формируется как нужно. Подскажите ещё , что необходимо прописать в макросе  для того , чтоб между итоговой строкой и последней заполненной строкой добавлялись пустые строки , понимаю . что строки можно добавить и вручную , но хотелось бы довести файл до логического конца...
 
Сергей Фенев, добавьте в коде после строки Дата договора:
Код
sh.Rows(lr + 1).Insert (xlDown)
Вредить легко, помогать трудно.
 

Имеется файл Excel с двумя листами , на одном из листов находится таблица с кодами подразделений УФМС России  и наименованиями  подразделений УФМС России . На другом листе в ячейку В3 вручную вбивается код подразделения , а в ячейке С3 автоматически должно отображаться наименование данного подразделения , в соответсвии с таблицей .Данную задачу начал реализовывать функцией ЕСЛИ , но это получится формула с несколькими сотнями ЕСЛИ , что не есть хорошо. Подскажите пожалуйста ,  каким образом возможно реализовать данную задачу при помощи  макроса.  Файл с примером прикладываю к вопросу .

 
Цитата
Начал реализововать задачу , применим функцию =ЕСЛИ(B3=Лист2!B5;Лист2!A5;ЕСЛИ(…..))….
начните с ИНДЕКС, не нужно сотни ЕСЛИ
(а если вы выбрали код 010-006, какое название ему соответствует?
ТП ОФМС РОССИИ ПО РЕСПУБЛИКЕ АДЫГЕЯ В КОШЕХАБЛЬСКОМ Р-НЕ
или
ТЕРРИТОРИАЛЬНЫМ ПУНКТОМ ОФМС РОССИИ ПО РЕСПУБЛИКЕ АДЫГЕЯ В КОШЕХАБЛЬСКОМ РАЙОНЕ
или
оба сразу? что должно быть в С3???
Код
=ИНДЕКС(Лист2!A:A;ПОИСКПОЗ(B3;Лист2!B:B;))
Изменено: Ігор Гончаренко - 20.07.2022 23:06:34
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Благодарю за  очень содержательный ответ , на самом деле всё работает как нужно . Что касается вопроса о повторяющихся значениях кода , то удалю повторяющиеся значения оставлю более подходящие мне.
 
Помогите понять ,что не так в коде ? Нужно , чтоб отчёт формировался в одной книге из данных в другой книге.
 
Сергей Фенев, так писать (программировать) нельзя (ошибка в жёлтой строке - вы добавили Workshet("GURNAL")
У вас файл ОТНЕТ.XLSM открыть во время выполнения макроса или этот файл закрыт, когда вы запускаете макрос?
Если ОТНЕТ.XLSM закрыт, то его надо сперва открыть макросом через Workbooks.Open("тут путь к файлу, без всяких Workshet("GURNAL" ")
Если ОТНЕТ.XLSM заранее открыт, то тогда так Set sh = Workbooks(ОТНЕТ.XLSM).Worksheets("GURNAL")

P.S. Не копируйте мой код из этого сообщения, так как я не знаю какими буквами написано у вас ОТНЕТ.xlsm - русскими или английскими. Я в коде написал русскими буквами, а у вас этот файл может называться английскими буквами. Визуально отличить ОТНЕТ (русскими буквами) от OTHET (английскими буквами) нельзя
Изменено: New - 30.09.2022 23:41:00
 
Все буквы английские , добавил в макрос команду открытия книги OTHET (отчёт) , но всё на том же моменте макрос тормозится . Помогите разобраться , что опять не так.
 
Либо не совпадают имя книги или имя листа, либо глюк Excel.
 
Прикладываю два файла Данные  и reestr . При вводе данных , в файл "Данные "  , должна заполняться таблица файла reestr.  Помогите пожалуйста. Макрос тормозиться на одном месте.
Изменено: Сергей Фенев - 01.10.2022 13:24:32
 
Оказалось третье...
Внимательно сравните, что написал New, и что вы. Буковки посчитайте.
 
Помогите новичку разобраться , что не так , желательно с исправлением макроса в файле "Данные" .  Прикладываю два файла Данные  и reestr . При вводе данных , в файл  "Данные "  , должна заполняться таблица файла reestr. Прикладываю так же фото , с выпадающей ошибкой. Помогите  пожалуйста.
 
Сравните свои картинки.
 
Цитата
написал:
Сравните свои картинки.
Я изменил названия файлов , что ещё сравнивать? Если конкретного ответа  по вопросу нет , то прошу не переливать с пустого в порожнее.
 
Сергей Фенев, предположу, что Вы задаете переменную sh как книгу, а ей присваиваете лист. Ну и метода/свойства Range у книги нет, поэтому ошибка. Вот Вам и сказали сравнить картинки, на первых картинках было Worksheet.
Может и не прав, в VBA слаб, проверяйте.
Изменено: whateverlover - 01.10.2022 19:05:16
 
whateverlover, браво!
Сергей Фенев, тут лечим, тут калечим?
 
Цитата
написал:
whateverlover, браво!
Сергей Фенев, тут лечим, тут калечим?
Цитата
написал:
whateverlover, браво!
Сергей Фенев, тут лечим, тут калечим?
Поэтому и прошу помощи  потому что только начинаю работу с VBA . Если знаете как исправить и запустить поставленную задачу - исправьте и по возможности объясните в чём моя ошибка , чтоб в будущем , я подобных ошибок не совершал . А осмеивать чужие ошибки , без реального объяснения - это не показатель знаний и умений...  (Сравни фото - это не объяснение и не для этого создаются форумы).
 
Путём сотен проб и сотен вариантов наконец-таки добился реального результата . Может кому понадобится , прикладываю рабочие файлы с рабочим макросом. Макрос в файле "Данные"
Изменено: Сергей Фенев - 01.10.2022 22:26:51
 
Сергей Фенев, в вашем макросе вы почему-то 2 раза открываете файл Reestr.xlsm. (если вы в коде пишите Workbooks.Open два раза, то вы 2 раза открываете файл)
Попробуйте так

Код
Sub Макрос2()
    Dim wbReestr As Workbook
    Dim shSheet1 As Worksheet
    Dim i As Long, lr As Long
        
    On Error Resume Next
    'если файл "reestr.xlsm" уже открыт то,
    Set wbReestr = Workbooks("reestr.xlsm")
    'если файл "reestr.xlsm" закрыт, то открываем его
    If wbReestr Is Nothing Then
        Set wbReestr = Workbooks.Open("C:\Users\NASTYA\Desktop\reestr.xlsm")
    End If
    On Error GoTo 0
    
    'Лист1 в файле с макросом (Данные.xlsm)
    Set shSheet1 = ThisWorkbook.Worksheets("Лист1")
    
    With wbReestr.Worksheets("reest")
        i = .Range("C6:C50000").Find("итого по реестру").Row
        lr = .Range("C" & i).End(xlUp).Row + 1
        .Range("C" & lr) = shSheet1.Range("D2").Value ' ФИО
        .Range("D" & lr) = shSheet1.Range("D7").Value ' Адрес
        .Range("E" & lr) = shSheet1.Range("D8").Value ' Модель счётчика
        .Range("F" & lr) = shSheet1.Range("D9").Value ' Номер счётчика
        .Range("G" & lr) = shSheet1.Range("D1").Value ' Номер договора
        .Rows(lr + 1).Insert (xlDown) ' Добавляет строку в таблице
    End With
    
    ThisWorkbook.Save 'сохраняем файл с макросом
    ThisWorkbook.Close 'закрываем файл с макросом
End Sub
Изменено: New - 01.10.2022 22:42:17
 
Благодарю за то, что уделили время на мою проблему .


Мне необходимо , чтоб данные из книги (Данные.xlsm) , заносились в таблицу книги (reestr.xlsm) по нажатию кнопки. Предварительно происходит проверка открыта ли книга reestr.xlsm , в том случае если книга открыта , то макрос её закрывает для исключения ошибки (Данная книга открыта , повторное её открытие приведёт к потере данных ....) . После чего происходит открытие книги reestr , в таблицу заносятся данные , книга макросом сохраняется и книга закрывается . Работа макроса меня устраивает. Может коряво написан , но работает так , как мне необходимо.
Макрос который вы прислали , заносит данные в таблицу и закрывает книгу (Данные.xlsm) , а книга reestr.xlsm остаётся открытой .  


После закрытия книги reestr.xlsm , книга Данные.xlsm должна оставаться открытой , для продолжения работы с ней .
Изменено: Сергей Фенев - 01.10.2022 23:00:24
 
Код
Sub Макрос2()
    Dim wbReestr As Workbook
    Dim shSheet1 As Worksheet
    Dim i As Long, lr As Long
        
    On Error Resume Next
    'если файл "reestr.xlsm" уже открыт то,
    Set wbReestr = Workbooks("reestr.xlsm")
    'если файл "reestr.xlsm" закрыт, то открываем его
    If wbReestr Is Nothing Then
        Set wbReestr = Workbooks.Open("C:\Users\NASTYA\Desktop\reestr.xlsm")
    End If
    On Error GoTo 0
    
    'Лист1 в файле с макросом (Данные.xlsm)
    Set shSheet1 = ThisWorkbook.Worksheets("Лист1")
    
    With wbReestr.Worksheets("reest")
        i = .Range("C6:C50000").Find("итого по реестру").Row
        lr = .Range("C" & i).End(xlUp).Row + 1
        .Range("C" & lr) = shSheet1.Range("D2").Value ' ФИО
        .Range("D" & lr) = shSheet1.Range("D7").Value ' Адрес
        .Range("E" & lr) = shSheet1.Range("D8").Value ' Модель счётчика
        .Range("F" & lr) = shSheet1.Range("D9").Value ' Номер счётчика
        .Range("G" & lr) = shSheet1.Range("D1").Value ' Номер договора
        .Rows(lr + 1).Insert (xlDown) ' Добавляет строку в таблице
    End With
    
    Application.DisplayAlerts = False
    wbReestr.Close (True) 'сохраняем и закрываем файл Reestr
    Application.DisplayAlerts = True
End Sub
 
Цитата
написал:
Код
    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31  32      Sub   Макрос2()          Dim   wbReestr   As   Workbook          Dim   shSheet1   As   Worksheet          Dim   i   As   Long  , lr   As   Long                       On   Error   Resume   Next          'если файл "reestr.xlsm" уже открыт то,          Set   wbReestr = Workbooks(  "reestr.xlsm"  )          'если файл "reestr.xlsm" закрыт, то открываем его          If   wbReestr   Is   Nothing   Then              Set   wbReestr = Workbooks.Open(  "C:\Users\NASTYA\Desktop\reestr.xlsm"  )          End   If          On   Error   GoTo   0                   'Лист1 в файле с макросом (Данные.xlsm)          Set   shSheet1 = ThisWorkbook.Worksheets(  "Лист1"  )                   With   wbReestr.Worksheets(  "reest"  )              i = .Range(  "C6:C50000"  ).Find(  "итого по реестру"  ).Row              lr = .Range(  "C"   & i).  End  (xlUp).Row + 1              .Range(  "C"   & lr) = shSheet1.Range(  "D2"  ).Value   ' ФИО              .Range(  "D"   & lr) = shSheet1.Range(  "D7"  ).Value   ' Адрес              .Range(  "E"   & lr) = shSheet1.Range(  "D8"  ).Value   ' Модель счётчика              .Range(  "F"   & lr) = shSheet1.Range(  "D9"  ).Value   ' Номер счётчика              .Range(  "G"   & lr) = shSheet1.Range(  "D1"  ).Value   ' Номер договора              .Rows(lr + 1).Insert (xlDown)   ' Добавляет строку в таблице          End   With                   Application.DisplayAlerts =   False          wbReestr.Close (  True  )   'сохраняем и закрываем файл Reestr          Application.DisplayAlerts =   True    End   Sub   
 
Спасибо огромнейшее , работает всё как нужно.
 
Сергей Фенев,  какой смысл цитировать код?
 
Цитата
написал:
Сергей Фенев,  какой смысл цитировать код?
Хотел показать за что благодарю . Если нарушил какие-либо правила , приношу извинения.
 
Сергей Фенев,  кнопка цитирования не для рответа. А обратиться можно по имени и поблагодарить.
Страницы: 1
Наверх