Public Sub numbers() With ActiveSheet.UsedRange For Each oCell In .Range("A:A,C:K,N:O") If oCell <> "" And Val(oCell) <> 0 Then oCell.Formula = Val(oCell) End If Next End With End Sub
[/vba]
если в таблицу будут добавляться столбцы справа, которые нужно будет обработать, то можно вместо
[vba]
Код
For Each oCell In .Range("A:A,C:K,N:O")
[/vba] написать [vba]
Код
For Each oCell In .Range("A:A,C:K,N:" & _ Split(Columns(.Column + .Columns.Count - 1).Address(False, False), ":")(0))
[/vba]
чтобы ускорить работу макроса можно ограничить диапазон, указав количество обрабатываемых строк, но этот способ работает только с непрерывными диапазонами, из-за этого приходится добавлять еще один цикл [vba]
Код
Public Sub numbers() With ActiveSheet.UsedRange For Each Rng In Array("A:A", "C:K", "N:O") For Each ocell In .Range(Rng).Rows(.Row & ":" & .Row + .Rows.Count - 1).Cells If ocell <> "" And Val(ocell) <> 0 Then ocell.Formula = Val(ocell) End If Next Next End With End Sub
[/vba]
как-то так [vba]
Код
Public Sub numbers() With ActiveSheet.UsedRange For Each oCell In .Range("A:A,C:K,N:O") If oCell <> "" And Val(oCell) <> 0 Then oCell.Formula = Val(oCell) End If Next End With End Sub
[/vba]
если в таблицу будут добавляться столбцы справа, которые нужно будет обработать, то можно вместо
[vba]
Код
For Each oCell In .Range("A:A,C:K,N:O")
[/vba] написать [vba]
Код
For Each oCell In .Range("A:A,C:K,N:" & _ Split(Columns(.Column + .Columns.Count - 1).Address(False, False), ":")(0))
[/vba]
чтобы ускорить работу макроса можно ограничить диапазон, указав количество обрабатываемых строк, но этот способ работает только с непрерывными диапазонами, из-за этого приходится добавлять еще один цикл [vba]
Код
Public Sub numbers() With ActiveSheet.UsedRange For Each Rng In Array("A:A", "C:K", "N:O") For Each ocell In .Range(Rng).Rows(.Row & ":" & .Row + .Rows.Count - 1).Cells If ocell <> "" And Val(ocell) <> 0 Then ocell.Formula = Val(ocell) End If Next Next End With End Sub
Serge_007, да, я это заметил, что-то под конец дня подтупливаю.
squadgazzz, То что я написал в формуле
Код
ТЕКСТ(4*30;"ММММ")
это получение названия месяца по номеру, где 4-номер искомого месяца. Если нужно получить номер, то вы должны хотя бы сообщить из каких данных, из какого формата его нужно получить. Если из даты в числовом формате, то
Код
=МЕСЯЦ(A1)
, если текущий месяц, то
Код
=МЕСЯЦ(СЕГОДНЯ())
, если из имени месяца, то воспользовавшись поиском по форуму нашли бы формулу выложенную Serge_007
Serge_007, да, я это заметил, что-то под конец дня подтупливаю.
squadgazzz, То что я написал в формуле
Код
ТЕКСТ(4*30;"ММММ")
это получение названия месяца по номеру, где 4-номер искомого месяца. Если нужно получить номер, то вы должны хотя бы сообщить из каких данных, из какого формата его нужно получить. Если из даты в числовом формате, то
Код
=МЕСЯЦ(A1)
, если текущий месяц, то
Код
=МЕСЯЦ(СЕГОДНЯ())
, если из имени месяца, то воспользовавшись поиском по форуму нашли бы формулу выложенную Serge_007
Public Sub numbers() For Each oCell In ActiveSheet.UsedRange.Cells If oCell <> "" And Val(oCell) <> 0 Then oCell.Formula = Val(oCell) End If Next End Sub
[/vba]
[vba]
Код
Public Sub numbers() For Each oCell In ActiveSheet.UsedRange.Cells If oCell <> "" And Val(oCell) <> 0 Then oCell.Formula = Val(oCell) End If Next End Sub
здравствуйте. Пишу проект на VBA. Делаю свое контекстное меню для листа. Меню создается при первом его вызове макросом и удаляется после закрытия книги. Вызывается оно таким кодом [vba]
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Application.CommandBars("cell").Enabled = False Application.CommandBars("List Range Popup").Enabled = False Application.CommandBars("row").Enabled = False Application.CommandBars("column").Enabled = False On Error GoTo 2 1: Application.CommandBars("меню1").ShowPopup Application.OnTime Now + TimeValue("00:00:01"), ThisWorkbook.Name & "!module1.restore" Exit Sub 2: menu = 1 Application.Run "'" & ThisWorkbook.Name & "'!module1.create_menu(menu)" GoTo 1 End Sub
[/vba]
вот код модуля restore: [vba]
Код
Sub restore() Application.CommandBars("cell").Enabled = True Application.CommandBars("list range popup").Enabled = True Application.CommandBars("row").Enabled = True Application.CommandBars("column").Enabled = True End Sub
[/vba]
при нажатии правой кнопкой мыши на листе при обычном режиме просмотра и в режиме разметки станицы все работает нормально - мое меню появляется, системные не появляются, но в страничном режиме после скрытия моего меню на доли секунды выскакивает системное меню. В чем моя ошибка и как это исправить?
здравствуйте. Пишу проект на VBA. Делаю свое контекстное меню для листа. Меню создается при первом его вызове макросом и удаляется после закрытия книги. Вызывается оно таким кодом [vba]
Код
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Application.CommandBars("cell").Enabled = False Application.CommandBars("List Range Popup").Enabled = False Application.CommandBars("row").Enabled = False Application.CommandBars("column").Enabled = False On Error GoTo 2 1: Application.CommandBars("меню1").ShowPopup Application.OnTime Now + TimeValue("00:00:01"), ThisWorkbook.Name & "!module1.restore" Exit Sub 2: menu = 1 Application.Run "'" & ThisWorkbook.Name & "'!module1.create_menu(menu)" GoTo 1 End Sub
[/vba]
вот код модуля restore: [vba]
Код
Sub restore() Application.CommandBars("cell").Enabled = True Application.CommandBars("list range popup").Enabled = True Application.CommandBars("row").Enabled = True Application.CommandBars("column").Enabled = True End Sub
[/vba]
при нажатии правой кнопкой мыши на листе при обычном режиме просмотра и в режиме разметки станицы все работает нормально - мое меню появляется, системные не появляются, но в страничном режиме после скрытия моего меню на доли секунды выскакивает системное меню. В чем моя ошибка и как это исправить?krosav4ig
Делаю макет тебеля т-12 с автозаполнением. Возникла необходимость создать именованный массив с такими значениями:
Код
={"ОЖ";"Отпуск по уходу за ребенком до достижения им возраста трех лет":"ДО";"Отпуск без сохранения заработной платы, предоставленный работнику по разрешению работодателя":"ОТ";"Ежегодный основной оплачиваемый отпуск":"К";"Служебная командировка":"У";"Дополнительный отпуск в связи с обучением с сохранением среднего заработка работникам, совмещающим работу с обучением":"Б";"Временная нетрудоспособность (кроме случаев, предусмотренных кодом ''Т'') с назначением пособия согласно законодательству":"НН";"Неявки по невыясненным причинам (до выяснения обстоятельств)":"ОД";"Ежегодный дополнительный оплачиваемый отпуск":"ПМ";"Повышение квалификации с отрывом от работы в другой местности":"Г";"Невыходы на время исполнения государственных или общественных обязанностей согласно законодательству":"ПР";"Прогулы (отсутствие на рабочем месте без уважительных причин в течение времени, установленного законодательством)":"УД";"Дополнительный отпуск в связи с обучением без сохранения заработной платы":"Р";"Отпуск по беременности и родам (отпуск в связи с усыновлением новорожденного ребенка)":"ПК";"Повышение квалификации с отрывом от работы":"В";"Выходные дни (еженедельный отпуск) и нерабочие праздничные дни":"УВ";"Сокращенная продолжительность рабочего времени для обучающихся без отрыва от производства с частичным сохранением заработной платы":"ОЗ";"Отпуск без сохранения заработной платы в случаях, предусмотренных законодательством":"Т";"Временная нетрудоспособность без назначения пособия в случаях, предусмотренных законодательством":"РП";"Продолжительность работы в выходные и нерабочие праздничные дни":"НП";"Время простоя по причинам, не зависящим от работодателя и работника":"ВП";"Время простоя по вине работника":"НО";"Отстранение от работы (недопущение к работе) с оплатой (пособием) в соответствии с законодательством":"НБ";"Отстранение от работы (недопущение к работе) по причинам, предусмотренным законодательством, без начисления заработной платы":"ДБ";"Ежегодный дополнительный отпуск без сохранения заработной платы":"ПВ";"Время вынужденного прогула в случае признания увольнения, перевода на другую работу или отстранения от работы незаконными с восстановлением на прежней работе":"ЗБ";"Забастовка (при условиях и в порядке, предусмотренных законом)":"НЗ";"Время приостановки работы в случае задержки выплаты заработной платы":"ОВ";"Дополнительные выходные дни (оплачиваемые)":"НВ";"Дополнительные выходные дни (без сохранения заработной платы)"}
но в поле ввода адреса не вводится больше 2084 символов. Есть ли какой-нибудь вариант кроме скоращения описания кодов? В листе по первому столбцу этого массива будут считаться неявки, в макросе из этого массива будут браться значения для создания контекстного меню
Делаю макет тебеля т-12 с автозаполнением. Возникла необходимость создать именованный массив с такими значениями:
Код
={"ОЖ";"Отпуск по уходу за ребенком до достижения им возраста трех лет":"ДО";"Отпуск без сохранения заработной платы, предоставленный работнику по разрешению работодателя":"ОТ";"Ежегодный основной оплачиваемый отпуск":"К";"Служебная командировка":"У";"Дополнительный отпуск в связи с обучением с сохранением среднего заработка работникам, совмещающим работу с обучением":"Б";"Временная нетрудоспособность (кроме случаев, предусмотренных кодом ''Т'') с назначением пособия согласно законодательству":"НН";"Неявки по невыясненным причинам (до выяснения обстоятельств)":"ОД";"Ежегодный дополнительный оплачиваемый отпуск":"ПМ";"Повышение квалификации с отрывом от работы в другой местности":"Г";"Невыходы на время исполнения государственных или общественных обязанностей согласно законодательству":"ПР";"Прогулы (отсутствие на рабочем месте без уважительных причин в течение времени, установленного законодательством)":"УД";"Дополнительный отпуск в связи с обучением без сохранения заработной платы":"Р";"Отпуск по беременности и родам (отпуск в связи с усыновлением новорожденного ребенка)":"ПК";"Повышение квалификации с отрывом от работы":"В";"Выходные дни (еженедельный отпуск) и нерабочие праздничные дни":"УВ";"Сокращенная продолжительность рабочего времени для обучающихся без отрыва от производства с частичным сохранением заработной платы":"ОЗ";"Отпуск без сохранения заработной платы в случаях, предусмотренных законодательством":"Т";"Временная нетрудоспособность без назначения пособия в случаях, предусмотренных законодательством":"РП";"Продолжительность работы в выходные и нерабочие праздничные дни":"НП";"Время простоя по причинам, не зависящим от работодателя и работника":"ВП";"Время простоя по вине работника":"НО";"Отстранение от работы (недопущение к работе) с оплатой (пособием) в соответствии с законодательством":"НБ";"Отстранение от работы (недопущение к работе) по причинам, предусмотренным законодательством, без начисления заработной платы":"ДБ";"Ежегодный дополнительный отпуск без сохранения заработной платы":"ПВ";"Время вынужденного прогула в случае признания увольнения, перевода на другую работу или отстранения от работы незаконными с восстановлением на прежней работе":"ЗБ";"Забастовка (при условиях и в порядке, предусмотренных законом)":"НЗ";"Время приостановки работы в случае задержки выплаты заработной платы":"ОВ";"Дополнительные выходные дни (оплачиваемые)":"НВ";"Дополнительные выходные дни (без сохранения заработной платы)"}
но в поле ввода адреса не вводится больше 2084 символов. Есть ли какой-нибудь вариант кроме скоращения описания кодов? В листе по первому столбцу этого массива будут считаться неявки, в макросе из этого массива будут браться значения для создания контекстного менюkrosav4ig
нет, нужно посчитать сумму очков по матчам (21 столбец), если победа - 2 очка, ничья - 1, поражение - 0, к примеру у зенита 3 и 5 матчи были победы , 4 - ничья итого 2*2+1=5
нет, нужно посчитать сумму очков по матчам (21 столбец), если победа - 2 очка, ничья - 1, поражение - 0, к примеру у зенита 3 и 5 матчи были победы , 4 - ничья итого 2*2+1=5krosav4ig
Sub MergeSelection() Dim Delim As String Dim delim2 As String Dim sMergeStr As String
Delim = "!" delim2 = "@"
Set rCells = Selection With rCells For Each rCell In .Cells If rCell <> "" Then sMergeStr = sMergeStr & Delim & rCell.Text Next rCell sMergeStr = Mid(sMergeStr, 1 + Len(Delim)) sMergeStr = Replace(sMergeStr, Delim, delim2) Application.DisplayAlerts = False .Merge Application.DisplayAlerts = True .Item(1).Value = Replace(sMergeStr, sMergeStr, Delim & sMergeStr & Delim) End With End Sub
[/vba]
[vba]
Код
Sub MergeSelection() Dim Delim As String Dim delim2 As String Dim sMergeStr As String
Delim = "!" delim2 = "@"
Set rCells = Selection With rCells For Each rCell In .Cells If rCell <> "" Then sMergeStr = sMergeStr & Delim & rCell.Text Next rCell sMergeStr = Mid(sMergeStr, 1 + Len(Delim)) sMergeStr = Replace(sMergeStr, Delim, delim2) Application.DisplayAlerts = False .Merge Application.DisplayAlerts = True .Item(1).Value = Replace(sMergeStr, sMergeStr, Delim & sMergeStr & Delim) End With End Sub