Function GetBetweenREXP(s$, strt_$, Optional end_$ = "") As Variant Dim subStr$(), i& end_ = IIf(end_ = "", "\1", end_) With CreateObject("vbscript.regexp") .Global = 1: .MultiLine = 1: .ignorecase = 1 .Pattern = "(?:(" & strt_ & ")(\s*))([\S\s]*?)(?=\2*" & end_ & "|\z)" If Not .test(s) Then Exit Function For Each m In .Execute(s) ReDim Preserve subStr(i) subStr(i) = m.submatches(2) i = i + 1 Next End With GetBetweenREXP = subStr End Function
[/vba]
Здравствуйте. [vba]
Код
Function GetBetweenREXP(s$, strt_$, Optional end_$ = "") As Variant Dim subStr$(), i& end_ = IIf(end_ = "", "\1", end_) With CreateObject("vbscript.regexp") .Global = 1: .MultiLine = 1: .ignorecase = 1 .Pattern = "(?:(" & strt_ & ")(\s*))([\S\s]*?)(?=\2*" & end_ & "|\z)" If Not .test(s) Then Exit Function For Each m In .Execute(s) ReDim Preserve subStr(i) subStr(i) = m.submatches(2) i = i + 1 Next End With GetBetweenREXP = subStr End Function
let Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content], #"Транспонированная таблица" = Table.Transpose(Источник), #"Заполнение вниз" = Table.FillDown(#"Транспонированная таблица",{"Column1"}), #"Объединенные столбцы" = Table.CombineColumns(#"Заполнение вниз",{"Column1", "Column2"},Combiner.CombineTextByDelimiter(" ", QuoteStyle.None)," "), #"Очищенный текст" = Table.TransformColumns(#"Объединенные столбцы",{{" ", Text.Trim, type text}}), #"Транспонированная таблица1" = Table.Transpose(#"Очищенный текст"), #"Повышенные заголовки" = Table.PromoteHeaders(#"Транспонированная таблица1", [PromoteAllScalars=true]), #"Добавлен индекс" = Table.AddIndexColumn(#"Повышенные заголовки", "Индекс", 0, 1), #"Сгруппированные строки1" = Table.Group(#"Добавлен индекс", {"Level"}, {{"tab", each _, type table}}), #"Сведенный столбец" = Table.Pivot(Table.TransformColumnTypes(#"Сгруппированные строки1", {{"Level", type text}}, "ru-RU"), List.Distinct(Table.TransformColumnTypes(#"Сгруппированные строки1", {{"Level", type text}}, "ru-RU")[Level]), "Level", "tab"), fn=(a as table, b as any,c as text,d as text, f as any,optional e as list) as table =>let g = Table.AddIndexColumn(a, "Индекс", 0, 1), h=Table.AddColumn(g, b&"+1",each try Record.Field(g{[Индекс]+1},b) otherwise null) , i=Table.ColumnNames(Record.Field(g{0},d)){0}, e=if e is null then {i,"Индекс"} else e, f=List.ReplaceValue(List.ReplaceValue(e, i, f, Replacer.ReplaceText), "Индекс", c, Replacer.ReplaceText), j=Table.ExpandTableColumn(h, d, e, f), k=b&"+1", l=try Table.SelectRows(j, each (Record.Field(_,c) > Record.Field(_,b) ) and (if Record.Field(_,k) is null then true else Record.Field(_,k)>Record.Field(_,c))) otherwise j in Table.RemoveColumns(if b<>"" then l else j,List.RemoveItems({b,"Индекс",k},{""})), expand=fn(fn(fn(#"Сведенный столбец","","i1","2","Категория"),"i1","i2","3","Производитель"),"i2","i3","4","Модель"), expand1=fn(expand,"i3","i4","5","Размер",Table.ColumnNames(#"Сведенный столбец"{0}[1])), result=Table.RemoveColumns(expand1,{"1","Level","i4"}) in result
[/vba]
еще один вариант в PowerQuery с допстолбцом
Код
получить.ячейку(28)
[vba]
Код
let Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content], #"Транспонированная таблица" = Table.Transpose(Источник), #"Заполнение вниз" = Table.FillDown(#"Транспонированная таблица",{"Column1"}), #"Объединенные столбцы" = Table.CombineColumns(#"Заполнение вниз",{"Column1", "Column2"},Combiner.CombineTextByDelimiter(" ", QuoteStyle.None)," "), #"Очищенный текст" = Table.TransformColumns(#"Объединенные столбцы",{{" ", Text.Trim, type text}}), #"Транспонированная таблица1" = Table.Transpose(#"Очищенный текст"), #"Повышенные заголовки" = Table.PromoteHeaders(#"Транспонированная таблица1", [PromoteAllScalars=true]), #"Добавлен индекс" = Table.AddIndexColumn(#"Повышенные заголовки", "Индекс", 0, 1), #"Сгруппированные строки1" = Table.Group(#"Добавлен индекс", {"Level"}, {{"tab", each _, type table}}), #"Сведенный столбец" = Table.Pivot(Table.TransformColumnTypes(#"Сгруппированные строки1", {{"Level", type text}}, "ru-RU"), List.Distinct(Table.TransformColumnTypes(#"Сгруппированные строки1", {{"Level", type text}}, "ru-RU")[Level]), "Level", "tab"), fn=(a as table, b as any,c as text,d as text, f as any,optional e as list) as table =>let g = Table.AddIndexColumn(a, "Индекс", 0, 1), h=Table.AddColumn(g, b&"+1",each try Record.Field(g{[Индекс]+1},b) otherwise null) , i=Table.ColumnNames(Record.Field(g{0},d)){0}, e=if e is null then {i,"Индекс"} else e, f=List.ReplaceValue(List.ReplaceValue(e, i, f, Replacer.ReplaceText), "Индекс", c, Replacer.ReplaceText), j=Table.ExpandTableColumn(h, d, e, f), k=b&"+1", l=try Table.SelectRows(j, each (Record.Field(_,c) > Record.Field(_,b) ) and (if Record.Field(_,k) is null then true else Record.Field(_,k)>Record.Field(_,c))) otherwise j in Table.RemoveColumns(if b<>"" then l else j,List.RemoveItems({b,"Индекс",k},{""})), expand=fn(fn(fn(#"Сведенный столбец","","i1","2","Категория"),"i1","i2","3","Производитель"),"i2","i3","4","Модель"), expand1=fn(expand,"i3","i4","5","Размер",Table.ColumnNames(#"Сведенный столбец"{0}[1])), result=Table.RemoveColumns(expand1,{"1","Level","i4"}) in result
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, [Таблица2]) Is Nothing And Target.Count = 1 Then Cells(Rows.Count, 1).End(xlUp).Offset(-7, 1).Resize(8).Calculate End If End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, [Таблица2]) Is Nothing And Target.Count = 1 Then Cells(Rows.Count, 1).End(xlUp).Offset(-7, 1).Resize(8).Calculate End If End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim Sh As Worksheet For Each Sh In Me.Windows(1).SelectedSheets Sh.PageSetup.CenterFooter = "Страница &P из " & Sh.HPageBreaks.Count + 1 Next End Sub Private Sub Workbook_SheetActivate(ByVal Sh As Object) Sh.PageSetup.CenterFooter = "Страница &P из &N" End Sub
[/vba]
Поместите этот код в модуль ЭтаКнига [vba]
Код
Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim Sh As Worksheet For Each Sh In Me.Windows(1).SelectedSheets Sh.PageSetup.CenterFooter = "Страница &P из " & Sh.HPageBreaks.Count + 1 Next End Sub Private Sub Workbook_SheetActivate(ByVal Sh As Object) Sh.PageSetup.CenterFooter = "Страница &P из &N" End Sub
Sub asd() Const dRh# = 15.75 Dim rRow As Range, r As Range, r1 As Range
With ActiveSheet.UsedRange .Interior.Color = xlNone For Each rRow In .Rows Select Case True Case rRow.RowHeight >= dRh If r Is Nothing Then Set r = rRow Else Set r = Union(r, rRow) End If Case rRow.RowHeight < dRh If r1 Is Nothing Then Set r1 = rRow Else Set r1 = Union(r1, rRow) End If End Select Next End With r.Rows.Interior.Color = vbRed r1.Rows.Interior.Color = vbGreen
End Sub
[/vba]
Здрвствуйте[vba]
Код
Sub asd() Const dRh# = 15.75 Dim rRow As Range, r As Range, r1 As Range
With ActiveSheet.UsedRange .Interior.Color = xlNone For Each rRow In .Rows Select Case True Case rRow.RowHeight >= dRh If r Is Nothing Then Set r = rRow Else Set r = Union(r, rRow) End If Case rRow.RowHeight < dRh If r1 Is Nothing Then Set r1 = rRow Else Set r1 = Union(r1, rRow) End If End Select Next End With r.Rows.Interior.Color = vbRed r1.Rows.Interior.Color = vbGreen