а если так выражусь: есть таблица с отсортированными строками по одному столбцу. Надо переместить или скопировать строки из этой таблицы в новые листы с названиями, соответсвующими значению в столбце B?
Добрый день. Кто бы мог подсказать, как решить такую задачу: существует таблица на 3000 строк. Как сделать автоматически (через макрос) следующее: 1. по столбцу B отсортировать таблицу 2. по каждому уникальному значению этого столбца B создать новые листы 3. перенести или скопировать строки в соответсвующие листы.
Часть таблицы с примером, как должно получиться, прикладываю
Спасибо, но здесь только закрытие файла. И подвисает жестко. Мне бы совместно: сначала требование включить макросы, а потом уже закрытие прие бездействии.
Добрый день Имеется код на требование включения макросов:
Код
'Данная процедура скрывает перед закрытием книги все листы,'кроме листа "WARNING"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Dim wsSh As Worksheet
Sheets("WARNING").Visible = -1
For Each wsSh In ThisWorkbook.Sheets
If wsSh.Name <> "WARNING" Then wsSh.Visible = 2
Next wsSh
ThisWorkbook.Save
End Sub
'Данная процедура показывает перед открытием книги все листы,
'кроме листа "WARNING"
Private Sub Workbook_Open()
Dim wsSh As Worksheet
For Each wsSh In ThisWorkbook.Sheets
wsSh.Visible = -1
Next wsSh
ThisWorkbook.Sheets("WARNING").Visible = 2
End Sub
Подскажите, а как дополнить сей код функцией автоматического закрытия документа с сохранением при бездействии пользователя, допустим, 5 минут?
спасибо, но немного не то. Не обновляются данные в таблице. Можно, конечно сделать несколько таблиц, и в финале раскидать, кто кому, но хочется красивого варианта
за 2 недели сума набегает немалая, так как будет оплата за ночлег, питание, посещение объектов и прочее. Все будет делиться на четверых поровну, без фуагра. Я просто попросил помочь с решением, а не с советом как быть и что делать
Добрый день. Собираемся в поздку на пару недель, и будем много платить один за другого, вернее по очереди каждый за всех четверых. После возвращения будет куча чеков. Помогите с решением этого задания, что бы в таблице кто/кому появились суммы распределения раходов.
Option Explicit
Dim DateTime As Date
Private Sub Workbook_Open()
DateTime = Now + #12:20:00 AM#
Application.OnTime DateTime, "TimeOut"
'???? ????????? ??????? ??????? ? ?????
iLastrow = Worksheets("log").Range("A60000").End(xlUp).Row
'??????? ??? ???????????? ? ????-????? ????? ? ????
Worksheets("log").Cells(Lastrow + 1, 1) = Environ("USERNAME")
Worksheets("log").Cells(Lastrow + 1, 2) = Now
'?????????? ??? ?????
For Each Sh In ActiveWorkbook.Worksheets
Sh.Visible = True
Next Sh
'???????? ????? ?????????????? ? ???
Worksheets("warning").Visible = xlSheetVeryHidden
Worksheets("log").Visible = xlSheetVeryHidden
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime DateTime, "TimeOut", , False
End Sub
'???? ????????? ??????? ??????? ? ?????
Lastrow = Worksheets("log").Range("A60000").End(xlUp).Row
'??????? ????-????? ?????? ?? ?????
If Lastrow > 1 Then Worksheets("log").Cells(Lastrow, 3) = Now
'???????? ??? ?????, ????? ????? ??????????????
Worksheets("warning").Visible = True
For Each Sh In ActiveWorkbook.Worksheets
If Sh.Name = "warning" Then
Sh.Visible = True
Else
Sh.Visible = xlSheetVeryHidden
End If
Next Sh
'??????????? ????? ???????
ActiveWorkbook.Save
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Workbook_BeforeClose False
Workbook_Open
End Sub
Все предельно понятно. Спасибо. Но когда я помещаю содержимое одного в другое, начинает ругаться, а я знаю, как потом все исправить.
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'èùåì ïîñëåäíþþ çàíÿòóþ ñòðî÷êó â ëîãàõ
lastrow = Worksheets("Ëîã").Range("A60000").End(xlUp).Row
'çàíîñèì äàòó-âðåìÿ âûõîäà èç ôàéëà
If lastrow > 1 Then Worksheets("Ëîã").Cells(lastrow, 3) = Now
'ñêðûâàåì âñå ëèñòû, êðîìå ëèñòà ÏÐÅÄÓÏÐÅÆÄÅÍÈÅ
Worksheets("Ïðåäóïðåæäåíèå").Visible = True
For Each Sh In ActiveWorkbook.Worksheets
If Sh.Name = "Ïðåäóïðåæäåíèå" Then
Sh.Visible = True
Else
Sh.Visible = xlSheetVeryHidden
End If
Next Sh
'ñîõðàíÿåìñÿ ïåðåä âûõîäîì
ActiveWorkbook.Save
End Sub
Private Sub Workbook_Open()
'èùåì ïîñëåäíþþ çàíÿòóþ ñòðî÷êó â ëîãàõ
lastrow = Worksheets("Ëîã").Range("A60000").End(xlUp).Row
'çàíîñèì èìÿ ïîëüçîâàòåëÿ è äàòó-âðåìÿ âõîäà â ôàéë
Worksheets("Ëîã").Cells(lastrow + 1, 1) = Environ("USERNAME")
Worksheets("Ëîã").Cells(lastrow + 1, 2) = Now
'îòîáðàæàåì âñå ëèñòû
For Each Sh In ActiveWorkbook.Worksheets
Sh.Visible = True
Next Sh
'ñêðûâàåì ëèñòû ÏÐÅÄÓÏÐÅÆÄÅÍÈÅ è ËÎÃ
Worksheets("Ïðåäóïðåæäåíèå").Visible = xlSheetVeryHidden
Worksheets("Ëîã").Visible = xlSheetVeryHidden
DateTime = Now + #12:10:00 AM#
Application.OnTime DateTime, "TimeOut"
End SubOption ExplicitDim DateTime As DatePrivate Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime DateTime, "TimeOut", , False
End SubPrivate Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Workbook_BeforeClose False
Workbook_Open
End Sub