Sub PlaceColon() With Me.UsedRange.Columns("A") .Value = Application.Replace(.Value, 7, 0, ",") .Replace ",,", ",", xlPart, , , , False, False .Replace ",", "", xlWhole, , , , False, False With Selection .Find "", .Cells, xlFormulas, 2, 1, 1, 0, 0 End With End With End Sub
[/vba]
до кучи макрос [vba]
Код
Sub PlaceColon() With Me.UsedRange.Columns("A") .Value = Application.Replace(.Value, 7, 0, ",") .Replace ",,", ",", xlPart, , , , False, False .Replace ",", "", xlWhole, , , , False, False With Selection .Find "", .Cells, xlFormulas, 2, 1, 1, 0, 0 End With End With End Sub
Private Sub Worksheet_Change(ByVal Target As Range) Dim vVal, oRE As Object
On Local Error Resume Next If Intersect(Target, Range("D9")) Is Nothing Then Exit Sub Application.EnableEvents = 0 With Target Set re = CreateObject("vbscript.regexp") re.Pattern = "^([0-1][0-9]|2[0-3])[0-5][0-9]$" vVal = Format(.Value, "0000") If re.test(vVal) Then .Value = Application.Replace(vVal, 3, 0, ":") .NumberFormat = "h:mm" Else MsgBox "Введенные данные не соответствуют времени в формате ччмм" Application.Undo End If End With Application.EnableEvents = True Set re = Nothing End Sub
[/vba]
Здравствуйте. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim vVal, oRE As Object
On Local Error Resume Next If Intersect(Target, Range("D9")) Is Nothing Then Exit Sub Application.EnableEvents = 0 With Target Set re = CreateObject("vbscript.regexp") re.Pattern = "^([0-1][0-9]|2[0-3])[0-5][0-9]$" vVal = Format(.Value, "0000") If re.test(vVal) Then .Value = Application.Replace(vVal, 3, 0, ":") .NumberFormat = "h:mm" Else MsgBox "Введенные данные не соответствуют времени в формате ччмм" Application.Undo End If End With Application.EnableEvents = True Set re = Nothing End Sub
let Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content], #"Измененный тип" = Table.TransformColumnTypes(Источник,{{"время", type datetime}, {"Код", Int64.Type}, {"Цвет", type text}, {"Имя", type text}}), #"Сгруппированные строки" = Table.Group(#"Измененный тип", {"время", "Код"}, {{"Цвет", each Text.Combine(List.Distinct([Цвет]),",")},{"Имя",each Text.Combine(List.Distinct([Имя]),",")}}) in #"Сгруппированные строки"
[/vba]
вариант через PowerQuery [vba]
Код
let Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content], #"Измененный тип" = Table.TransformColumnTypes(Источник,{{"время", type datetime}, {"Код", Int64.Type}, {"Цвет", type text}, {"Имя", type text}}), #"Сгруппированные строки" = Table.Group(#"Измененный тип", {"время", "Код"}, {{"Цвет", each Text.Combine(List.Distinct([Цвет]),",")},{"Имя",each Text.Combine(List.Distinct([Имя]),",")}}) in #"Сгруппированные строки"
Sub d() Dim arr() As Variant Dim r As Range Set r = Parent.Sheets("Лист1").UsedRange With Me.UsedRange.Columns("B:E") arr = .Value For i = 1 To UBound(arr) For j = 2 To UBound(arr, 2) Step 2 With Application arr(i, j) = .IfError(.VLookup(arr(i, j - 1), r, 3, 0), "") End With Next Next .Value = arr End With End Sub
[/vba] до кучи в обратную сторону [vba]
Код
Sub d() Dim arr() As Variant Dim rng As Range Set rng = Parent.Sheets("Лист2").UsedRange With Me.UsedRange.Columns("A:C") arr = .Value For i = 1 To UBound(arr) Set r = rng.Find(arr(i, 1), , xlValues, xlWhole, , , False, , False) If Not r Is Nothing Then arr(i, 3) = r.Offset(, 1).Value Next .Value = arr End With End Sub
Sub d() Dim arr() As Variant Dim r As Range Set r = Parent.Sheets("Лист1").UsedRange With Me.UsedRange.Columns("B:E") arr = .Value For i = 1 To UBound(arr) For j = 2 To UBound(arr, 2) Step 2 With Application arr(i, j) = .IfError(.VLookup(arr(i, j - 1), r, 3, 0), "") End With Next Next .Value = arr End With End Sub
[/vba] до кучи в обратную сторону [vba]
Код
Sub d() Dim arr() As Variant Dim rng As Range Set rng = Parent.Sheets("Лист2").UsedRange With Me.UsedRange.Columns("A:C") arr = .Value For i = 1 To UBound(arr) Set r = rng.Find(arr(i, 1), , xlValues, xlWhole, , , False, , False) If Not r Is Nothing Then arr(i, 3) = r.Offset(, 1).Value Next .Value = arr End With End Sub
Эт как же вы собираетесь из такой каракатицы свод делать? :facepalm: нарисовал запрос в PowerQuery для всех годов и вариантов, на его основе строится сводная (на листе Лист1), запрос обновляется обновлением сводной или командой Обновить все (Ctrl+Alt+F5). Из сводной формулами данные тянутся в вашу таблицу
[vba]
Код
let Источник = Excel.CurrentWorkbook(){[Name="Данные"]}[Content], #"Повышенные заголовки" = Table.PromoteHeaders(Источник, [PromoteAllScalars=true]), Пользовательская1 = Table.FromRecords(Table.TransformRows(#"Повышенные заголовки",each let n=Number.From([#"Дата конец"]-[#"Дата начало"])+1 in [#"№ работника"=[#"№"],сумма=#table({"Вариант","Сумма"},{{"Вариант 1",[#"Этот столбец для Варианта № 1"]/n},{"Вариант 2",[#"Этот столбец для Варианта № 2"]/n}}),#"Дата"=List.Transform({Number.From([#"Дата начало"])..Number.From([#"Дата конец"])},Date.From)])), #"Развернутый элемент сумма" = Table.ExpandTableColumn(Пользовательская1, "сумма", {"Вариант", "Сумма"}, {"Вариант", "Сумма"}), #"Развернутый элемент дата" = Table.ExpandListColumn(#"Развернутый элемент сумма", "Дата"), #"Добавлен пользовательский объект" = Table.AddColumn(#"Развернутый элемент дата", "Год", each Date.Year([Дата])), #"Добавлен пользовательский объект1" = Table.AddColumn(#"Добавлен пользовательский объект", "Квартал", each Text.Replace(Text.Repeat("I",Date.QuarterOfYear([Дата])),"IIII","IV")&" квартал"), #"Добавлен пользовательский объект2" = Table.AddColumn(#"Добавлен пользовательский объект1", "Месяц", each Date.MonthName([Дата],"ru-ru")), #"Добавлен пользовательский объект3" = Table.AddColumn(#"Добавлен пользовательский объект2", "Декада", each Text.Repeat("I",List.Min({3,Number.RoundDown((Date.Day([Дата])+9)/10)}))&" декада"), #"Сгруппированные строки" = Table.Group(#"Добавлен пользовательский объект3", {"№ работника", "Вариант", "Год", "Квартал", "Месяц", "Декада"}, {{"Сумма", each List.Sum([Сумма]), type number}}) in #"Сгруппированные строки"
[/vba]
чую, следующий вопрос будет, как будет выглядеть 2018 год внутри того же файла...
Эт как же вы собираетесь из такой каракатицы свод делать? :facepalm: нарисовал запрос в PowerQuery для всех годов и вариантов, на его основе строится сводная (на листе Лист1), запрос обновляется обновлением сводной или командой Обновить все (Ctrl+Alt+F5). Из сводной формулами данные тянутся в вашу таблицу
[vba]
Код
let Источник = Excel.CurrentWorkbook(){[Name="Данные"]}[Content], #"Повышенные заголовки" = Table.PromoteHeaders(Источник, [PromoteAllScalars=true]), Пользовательская1 = Table.FromRecords(Table.TransformRows(#"Повышенные заголовки",each let n=Number.From([#"Дата конец"]-[#"Дата начало"])+1 in [#"№ работника"=[#"№"],сумма=#table({"Вариант","Сумма"},{{"Вариант 1",[#"Этот столбец для Варианта № 1"]/n},{"Вариант 2",[#"Этот столбец для Варианта № 2"]/n}}),#"Дата"=List.Transform({Number.From([#"Дата начало"])..Number.From([#"Дата конец"])},Date.From)])), #"Развернутый элемент сумма" = Table.ExpandTableColumn(Пользовательская1, "сумма", {"Вариант", "Сумма"}, {"Вариант", "Сумма"}), #"Развернутый элемент дата" = Table.ExpandListColumn(#"Развернутый элемент сумма", "Дата"), #"Добавлен пользовательский объект" = Table.AddColumn(#"Развернутый элемент дата", "Год", each Date.Year([Дата])), #"Добавлен пользовательский объект1" = Table.AddColumn(#"Добавлен пользовательский объект", "Квартал", each Text.Replace(Text.Repeat("I",Date.QuarterOfYear([Дата])),"IIII","IV")&" квартал"), #"Добавлен пользовательский объект2" = Table.AddColumn(#"Добавлен пользовательский объект1", "Месяц", each Date.MonthName([Дата],"ru-ru")), #"Добавлен пользовательский объект3" = Table.AddColumn(#"Добавлен пользовательский объект2", "Декада", each Text.Repeat("I",List.Min({3,Number.RoundDown((Date.Day([Дата])+9)/10)}))&" декада"), #"Сгруппированные строки" = Table.Group(#"Добавлен пользовательский объект3", {"№ работника", "Вариант", "Год", "Квартал", "Месяц", "Декада"}, {{"Сумма", each List.Sum([Сумма]), type number}}) in #"Сгруппированные строки"