Интересно сравнить аналогичное с работой PowerQuery
Ну пока anvg молчит попробую я чего-нить путного изобразить [vba]
Код
let Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content], Отбор = Table.AddColumn( Источник, "Строка", each let клиент=[Номер клиента], закрыто=[Дата закрытия], тема=[Тема обращения] in Table.First( Table.SelectRows( Источник, each [Номер клиента]=клиент and [Дата создания]>закрыто and [Тема обращения]=тема ) ) ), Повтор = Table.FromRecords( Table.TransformRows( Отбор, each Record.TransformFields( _ , let r = _ in { "Повтор", each try if ((r[Строка][Дата создания]-r[Дата закрытия]))<#duration(0,48,1,0) then "Повторное" else "Единичное" otherwise "Единичное" } ) ) ), #"Удаленные столбцы" = Table.RemoveColumns(Повтор,{"Строка"}), #"Измененный тип" = Table.TransformColumnTypes(#"Удаленные столбцы",{{"Код.обращения", Int64.Type}, {"Номер клиента", Int64.Type}, {"Дата создания", type datetime}, {"Дата закрытия", type datetime}, {"Тема обращения", type text}, {"Повтор", type text}}) in #"Измененный тип"
Интересно сравнить аналогичное с работой PowerQuery
Ну пока anvg молчит попробую я чего-нить путного изобразить [vba]
Код
let Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content], Отбор = Table.AddColumn( Источник, "Строка", each let клиент=[Номер клиента], закрыто=[Дата закрытия], тема=[Тема обращения] in Table.First( Table.SelectRows( Источник, each [Номер клиента]=клиент and [Дата создания]>закрыто and [Тема обращения]=тема ) ) ), Повтор = Table.FromRecords( Table.TransformRows( Отбор, each Record.TransformFields( _ , let r = _ in { "Повтор", each try if ((r[Строка][Дата создания]-r[Дата закрытия]))<#duration(0,48,1,0) then "Повторное" else "Единичное" otherwise "Единичное" } ) ) ), #"Удаленные столбцы" = Table.RemoveColumns(Повтор,{"Строка"}), #"Измененный тип" = Table.TransformColumnTypes(#"Удаленные столбцы",{{"Код.обращения", Int64.Type}, {"Номер клиента", Int64.Type}, {"Дата создания", type datetime}, {"Дата закрытия", type datetime}, {"Тема обращения", type text}, {"Повтор", type text}}) in #"Измененный тип"
let Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content], Пользовательская1 = Table.FromRecords(Table.TransformRows(Источник,each [Данные=[Данные],Результат=try Text.Combine(List.Transform(List.Select(Text.Split([Данные],","),each Text.Contains(_,"DC")),Text.Trim),", ") otherwise ""])) in Пользовательская1
[/vba]
вариант через Power Query
[vba]
Код
let Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content], Пользовательская1 = Table.FromRecords(Table.TransformRows(Источник,each [Данные=[Данные],Результат=try Text.Combine(List.Transform(List.Select(Text.Split([Данные],","),each Text.Contains(_,"DC")),Text.Trim),", ") otherwise ""])) in Пользовательская1
Исправил свой пост, написал фигню какую-то сгородил до кучи, QuickSort [vba]
Код
Option Explicit Sub sort() Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, c As Integer Dim v() As Long Dim b As Boolean
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2 n = InputBox("введите размер двумерного массива", "массив", 3) If n > Int((2 ^ 15 - 1) ^ 0.5) Then Err.Raise 6 'максимальное значение integer = 2^15-1 ReDim v(1 To n, 1 To n) ' иннициация 2-мерного массива Randomize 'инициализация генератора случайных чисел For i = 1 To n: For j = 1 To n v(i, j) = Int(Rnd * 1000) ' заполнение 2-мерного массива рандомными числами Next j, i With WSh.Cells(1).Resize(i - 1, j - 1) .Value = v ' выгрузка массива на лист ' Сортировка полученного 2-мерного массива пузырьком Quicksort v, 0, n ^ 2 - 1, n .Offset(n + 1) = v() ' записываем отсортированные строки 2-мерного массива в Лист2 End With End Sub Sub Quicksort(ByRef values&(), ByVal min As Long, ByVal max As Long, n%)
Dim med_value As String Dim hi As Long Dim lo As Long Dim i As Long
' If the list has only 1 item, it's sorted. If min >= max Then Exit Sub
' Pick a dividing item randomly. i = min + Int(Rnd(max - min + 1)) med_value = values(i \ n + 1, i Mod n + 1)
' Swap the dividing item to the front of the list. values(i \ n + 1, i Mod n + 1) = values(min \ n + 1, min Mod n + 1)
' Separate the list into sublists. lo = min hi = max Do ' Look down from hi for a value < med_value. Do While values(hi \ n + 1, hi Mod n + 1) >= med_value hi = hi - 1 If hi <= lo Then Exit Do Loop
If hi <= lo Then ' The list is separated. values(lo \ n + 1, lo Mod n + 1) = med_value Exit Do End If
' Swap the lo and hi values. values(lo \ n + 1, lo Mod n + 1) = values(hi \ n + 1, hi Mod n + 1)
' Look up from lo for a value >= med_value. lo = lo + 1 Do While values(lo \ n + 1, lo Mod n + 1) < med_value lo = lo + 1 If lo >= hi Then Exit Do Loop
If lo >= hi Then ' The list is separated. lo = hi values(hi \ n + 1, hi Mod n + 1) = med_value Exit Do End If
' Swap the lo and hi values. values(hi \ n + 1, hi Mod n + 1) = values(lo \ n + 1, lo Mod n + 1) Loop ' Loop until the list is separated.
' Recursively sort the sublists. Quicksort values, min, lo - 1, n Quicksort values, lo + 1, max, n
End Sub
[/vba]
Исправил свой пост, написал фигню какую-то сгородил до кучи, QuickSort [vba]
Код
Option Explicit Sub sort() Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, c As Integer Dim v() As Long Dim b As Boolean
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2 n = InputBox("введите размер двумерного массива", "массив", 3) If n > Int((2 ^ 15 - 1) ^ 0.5) Then Err.Raise 6 'максимальное значение integer = 2^15-1 ReDim v(1 To n, 1 To n) ' иннициация 2-мерного массива Randomize 'инициализация генератора случайных чисел For i = 1 To n: For j = 1 To n v(i, j) = Int(Rnd * 1000) ' заполнение 2-мерного массива рандомными числами Next j, i With WSh.Cells(1).Resize(i - 1, j - 1) .Value = v ' выгрузка массива на лист ' Сортировка полученного 2-мерного массива пузырьком Quicksort v, 0, n ^ 2 - 1, n .Offset(n + 1) = v() ' записываем отсортированные строки 2-мерного массива в Лист2 End With End Sub Sub Quicksort(ByRef values&(), ByVal min As Long, ByVal max As Long, n%)
Dim med_value As String Dim hi As Long Dim lo As Long Dim i As Long
' If the list has only 1 item, it's sorted. If min >= max Then Exit Sub
' Pick a dividing item randomly. i = min + Int(Rnd(max - min + 1)) med_value = values(i \ n + 1, i Mod n + 1)
' Swap the dividing item to the front of the list. values(i \ n + 1, i Mod n + 1) = values(min \ n + 1, min Mod n + 1)
' Separate the list into sublists. lo = min hi = max Do ' Look down from hi for a value < med_value. Do While values(hi \ n + 1, hi Mod n + 1) >= med_value hi = hi - 1 If hi <= lo Then Exit Do Loop
If hi <= lo Then ' The list is separated. values(lo \ n + 1, lo Mod n + 1) = med_value Exit Do End If
' Swap the lo and hi values. values(lo \ n + 1, lo Mod n + 1) = values(hi \ n + 1, hi Mod n + 1)
' Look up from lo for a value >= med_value. lo = lo + 1 Do While values(lo \ n + 1, lo Mod n + 1) < med_value lo = lo + 1 If lo >= hi Then Exit Do Loop
If lo >= hi Then ' The list is separated. lo = hi values(hi \ n + 1, hi Mod n + 1) = med_value Exit Do End If
' Swap the lo and hi values. values(hi \ n + 1, hi Mod n + 1) = values(lo \ n + 1, lo Mod n + 1) Loop ' Loop until the list is separated.
' Recursively sort the sublists. Quicksort values, min, lo - 1, n Quicksort values, lo + 1, max, n
Sub sort() Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, c As Integer Dim V() As Long Dim b As Boolean
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2 n = InputBox("введите размер двумерного массива", "массив", 3) If n > Int((2 ^ 15 - 1) ^ 0.5) Then Err.Raise 6 'максимальное значение integer = 2^15-1 ReDim V(1 To n, 1 To n) ' иннициация 2-мерного массива Randomize 'инициализация генератора случайных чисел For i = 1 To n: For j = 1 To n V(i, j) = Int(Rnd * 1000) ' заполнение 2-мерного массива рандомными числами Next j, i With WSh.Cells(1).Resize(i - 1, j - 1) .Value = V ' выгрузка массива на лист ' Сортировка полученного 2-мерного массива пузырьком For i = 0 To n ^ 2 - 2: For j = i To n ^ 2 - 1 Swap V(i \ n + 1, i Mod n + 1), V(j \ n + 1, j Mod n + 1) Next j, i .Offset(n + 1) = V() ' записываем отсортированные строки 2-мерного массива в Лист2 End With End Sub Private Function Swap(ByRef a&, ByRef b&) If a > b Then: Dim c&: c = a: a = b: b = d End Function
[/vba]
Здравствуйте. [vba]
Код
Sub sort() Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, c As Integer Dim V() As Long Dim b As Boolean
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2 n = InputBox("введите размер двумерного массива", "массив", 3) If n > Int((2 ^ 15 - 1) ^ 0.5) Then Err.Raise 6 'максимальное значение integer = 2^15-1 ReDim V(1 To n, 1 To n) ' иннициация 2-мерного массива Randomize 'инициализация генератора случайных чисел For i = 1 To n: For j = 1 To n V(i, j) = Int(Rnd * 1000) ' заполнение 2-мерного массива рандомными числами Next j, i With WSh.Cells(1).Resize(i - 1, j - 1) .Value = V ' выгрузка массива на лист ' Сортировка полученного 2-мерного массива пузырьком For i = 0 To n ^ 2 - 2: For j = i To n ^ 2 - 1 Swap V(i \ n + 1, i Mod n + 1), V(j \ n + 1, j Mod n + 1) Next j, i .Offset(n + 1) = V() ' записываем отсортированные строки 2-мерного массива в Лист2 End With End Sub Private Function Swap(ByRef a&, ByRef b&) If a > b Then: Dim c&: c = a: a = b: b = d End Function
t330, ну дык та же самая ошибка (424, Дай объект) Растет отсюда У вас функция выполняется из обычного макроса, и, в соответствии с таблицей по ссылке, Application.Caller принимает значение #REF! и ,следовательно, не является объектом и не может наследовать у класса Range свойство Address Мыж с Александром ( _Boroda_) не просто так писали
With Application If TypeName(.Caller) = "Range" Then Addr1 = .Caller.Address End With For Each Wksht In cell.Parent.Parent.Worksheets If Wksht.Name = cell.Parent.Name And Addr = Addr1 Then
On Error Resume Next ac_ = Application.Caller.Address For Each Wksht In cell.Parent.Parent.Worksheets If Wksht.Name = cell.Parent.Name And Addr = ac_ Then
t330, ну дык та же самая ошибка (424, Дай объект) Растет отсюда У вас функция выполняется из обычного макроса, и, в соответствии с таблицей по ссылке, Application.Caller принимает значение #REF! и ,следовательно, не является объектом и не может наследовать у класса Range свойство Address Мыж с Александром ( _Boroda_) не просто так писали
With Application If TypeName(.Caller) = "Range" Then Addr1 = .Caller.Address End With For Each Wksht In cell.Parent.Parent.Worksheets If Wksht.Name = cell.Parent.Name And Addr = Addr1 Then
On Error Resume Next ac_ = Application.Caller.Address For Each Wksht In cell.Parent.Parent.Worksheets If Wksht.Name = cell.Parent.Name And Addr = ac_ Then
Это просто очень большое отрицательное число, нужно, чтобы находилось максимальное число и среди отрицательных тоже, и во избежание лишнего цикла для поиска минимального числа
[vba]
Код
Function MAXALLSHEETS(cell) Dim MaxVal As Double Dim Addr As String, Addr1 As String Dim Wksht As Object Application.Volatile Addr = cell.Range("A1").Address MaxVal = -9.9E+307 With Application If TypeName(.Caller) = "Range" Then Addr1 = .Caller.Address End With For Each Wksht In cell.Parent.Parent.Worksheets If Wksht.Name = cell.Parent.Name And Addr = Addr1 Then ' исключение циркулярной ссылки Else If IsNumeric(Wksht.Range(Addr)) Then If Wksht.Range(Addr) > MaxVal Then _ MaxVal = Wksht.Range(Addr).Value End If End If Next Wksht If MaxVal = -9.9E+307 Then MaxVal = 0 MAXALLSHEETS = MaxVal End Function
Это просто очень большое отрицательное число, нужно, чтобы находилось максимальное число и среди отрицательных тоже, и во избежание лишнего цикла для поиска минимального числа
[vba]
Код
Function MAXALLSHEETS(cell) Dim MaxVal As Double Dim Addr As String, Addr1 As String Dim Wksht As Object Application.Volatile Addr = cell.Range("A1").Address MaxVal = -9.9E+307 With Application If TypeName(.Caller) = "Range" Then Addr1 = .Caller.Address End With For Each Wksht In cell.Parent.Parent.Worksheets If Wksht.Name = cell.Parent.Name And Addr = Addr1 Then ' исключение циркулярной ссылки Else If IsNumeric(Wksht.Range(Addr)) Then If Wksht.Range(Addr) > MaxVal Then _ MaxVal = Wksht.Range(Addr).Value End If End If Next Wksht If MaxVal = -9.9E+307 Then MaxVal = 0 MAXALLSHEETS = MaxVal End Function
Private Sub btnOK_Click() With [Таблица2].ListObject For i = 1 To lbDays.ListCount If lbDays.Selected(i - 1) Then With .ListRows.Add.Range For j = 1 To lbDays.ColumnCount .Cells(1, j) = lbDays.List(i - 1, j - 1) Next End With End If Next End With End Sub
Private Sub btnOK_Click() With [Таблица2].ListObject For i = 1 To lbDays.ListCount If lbDays.Selected(i - 1) Then With .ListRows.Add.Range For j = 1 To lbDays.ColumnCount .Cells(1, j) = lbDays.List(i - 1, j - 1) Next End With End If Next End With End Sub
Private Sub btnOK_Click() With [Таблица2].ListObject For i = 1 To lbDays.ListCount If lbDays.Selected(i - 1) Then With .ListRows.Add.Range For j = 1 To lbDays.ColumnCount .Cells(1, j) = lbDays.List(i - 1, j - 1) Next End With End If Next End With End Sub
[/vba]
Сам накосячил, сам исправляю :)[vba]
Код
Private Sub btnOK_Click() With [Таблица2].ListObject For i = 1 To lbDays.ListCount If lbDays.Selected(i - 1) Then With .ListRows.Add.Range For j = 1 To lbDays.ColumnCount .Cells(1, j) = lbDays.List(i - 1, j - 1) Next End With End If Next End With End Sub
let t=(nam as text)=>Excel.CurrentWorkbook(){[Name=nam]}[Content], Массив = t("Массив"), Критерии = t("Критерии"), Фильтр = Table.SelectRows(Массив, each let r=_ in List.AllTrue(List.Transform(Table.ToRows(Критерии),each Record.Field(r,_{0})=_{1}))), Топ10 = Table.AddIndexColumn(Table.FirstN(Table.Sort(Фильтр,{{"Выручка", Order.Descending}}),10), "Рейтинг по выручке", 1, 1) in Table.ReorderColumns(Топ10,List.InsertRange(Table.ColumnNames(Массив),0,{"Рейтинг по выручке"}))
[/vba]
Вариант через Power Query
[vba]
Код
let t=(nam as text)=>Excel.CurrentWorkbook(){[Name=nam]}[Content], Массив = t("Массив"), Критерии = t("Критерии"), Фильтр = Table.SelectRows(Массив, each let r=_ in List.AllTrue(List.Transform(Table.ToRows(Критерии),each Record.Field(r,_{0})=_{1}))), Топ10 = Table.AddIndexColumn(Table.FirstN(Table.Sort(Фильтр,{{"Выручка", Order.Descending}}),10), "Рейтинг по выручке", 1, 1) in Table.ReorderColumns(Топ10,List.InsertRange(Table.ColumnNames(Массив),0,{"Рейтинг по выручке"}))