Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Записи участника (krosav4ig) - Мир MS Excel

Старая форма входа
Мир MS Excel » Записи участника » krosav4ig [2347]
Результаты поиска
krosav4ig Дата: Понедельник, 08.07.2019, 21:36 | Сообщение № 2101 | Тема: Заполнение ячеек таблиц согласно дат и определенных значений
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте
Код
=1-ЕПУСТО(A3)
Код
=--(ПРАВБ(A3)="О")
Код
=ЕПУСТО(E3)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте
Код
=1-ЕПУСТО(A3)
Код
=--(ПРАВБ(A3)="О")
Код
=ЕПУСТО(E3)

Автор - krosav4ig
Дата добавления - 08.07.2019 в 21:36
krosav4ig Дата: Вторник, 09.07.2019, 11:01 | Сообщение № 2102 | Тема: Макрос перехода по условию
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 09.07.2019, 11:03
 
Ответить
СообщениеSelect Case statement

Автор - krosav4ig
Дата добавления - 09.07.2019 в 11:01
krosav4ig Дата: Вторник, 09.07.2019, 18:31 | Сообщение № 2103 | Тема: Как выбрать значение из массива по нескольким критериям?
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Вариант с модификацией шапки таблицы
Код
=ПРОСМОТР(2;1/(D2>=C$13:U$13)/(E2>=C$15:U$15);ИНДЕКС(C:U;ПРОСМОТР(2;1/(B2>=A$16:A$47)/((B$16:B$47="")+(C2>=B$16:B$47));СТРОКА(A$16:A$47));))
К сообщению приложен файл: 9137017.xls (43.0 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеВариант с модификацией шапки таблицы
Код
=ПРОСМОТР(2;1/(D2>=C$13:U$13)/(E2>=C$15:U$15);ИНДЕКС(C:U;ПРОСМОТР(2;1/(B2>=A$16:A$47)/((B$16:B$47="")+(C2>=B$16:B$47));СТРОКА(A$16:A$47));))

Автор - krosav4ig
Дата добавления - 09.07.2019 в 18:31
krosav4ig Дата: Суббота, 20.07.2019, 16:25 | Сообщение № 2104 | Тема: Копирование диапазона через переменную
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте

.Value не хватает[vba]
Код
Sub test_copy()

Dim rng As Range

Set rng = Range(Cells(1, 1), Cells(36, 8))

Cells(37, 1).Resize(36, 8) = rng.Value

End Sub
[/vba]
[vba]
Код
Sub test_copy_()
    With [A1].Resize(36, 8)
        .Offset(36) = .Value
    End With
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте

.Value не хватает[vba]
Код
Sub test_copy()

Dim rng As Range

Set rng = Range(Cells(1, 1), Cells(36, 8))

Cells(37, 1).Resize(36, 8) = rng.Value

End Sub
[/vba]
[vba]
Код
Sub test_copy_()
    With [A1].Resize(36, 8)
        .Offset(36) = .Value
    End With
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 20.07.2019 в 16:25
krosav4ig Дата: Воскресенье, 21.07.2019, 05:17 | Сообщение № 2105 | Тема: Вычислить kbps аудио по размеру файла и продолжительности
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Код
=B2/(ЕСЛИОШИБКА(Т(ПОИСК(":*:";C2));"0:")&C2)*64/675


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
Код
=B2/(ЕСЛИОШИБКА(Т(ПОИСК(":*:";C2));"0:")&C2)*64/675

Автор - krosav4ig
Дата добавления - 21.07.2019 в 05:17
krosav4ig Дата: Воскресенье, 21.07.2019, 18:12 | Сообщение № 2106 | Тема: Вычислить kbps аудио по размеру файла и продолжительности
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[offtop]
А если
бы у бабушки кой-чего было, то это была бы не бабушка вовсе[/offtop]
в последнем файле у вас в С2 стоит время 29:07:00 - 29 часов 7 минут. Как вы предлагаете Excelю догадываться, что это на самом деле должно быть 00:29:07


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение[offtop]
А если
бы у бабушки кой-чего было, то это была бы не бабушка вовсе[/offtop]
в последнем файле у вас в С2 стоит время 29:07:00 - 29 часов 7 минут. Как вы предлагаете Excelю догадываться, что это на самом деле должно быть 00:29:07

Автор - krosav4ig
Дата добавления - 21.07.2019 в 18:12
krosav4ig Дата: Понедельник, 22.07.2019, 12:57 | Сообщение № 2107 | Тема: Нумерация страниц с пропуском страницы
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
В настройках страницы ставим галочки Различать колонтитулы четных и нечетных страниц и первой страницы
в колонтитул нечетной станицы помещаем поле [vba]
Код
{=({page}+1)/2}
[/vba]

или без галочек в настройках страницы в колонтитул помещаем поле [vba]
Код
{if {page} > 2 "{if {=MOD({={page}/2};1)} > 0 {=({page}+1)/2}}" ""}
[/vba]
К сообщению приложен файл: 3567064-1.docx (15.4 Kb) · 3567064-2.docx (15.6 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 22.07.2019, 12:58
 
Ответить
СообщениеВ настройках страницы ставим галочки Различать колонтитулы четных и нечетных страниц и первой страницы
в колонтитул нечетной станицы помещаем поле [vba]
Код
{=({page}+1)/2}
[/vba]

или без галочек в настройках страницы в колонтитул помещаем поле [vba]
Код
{if {page} > 2 "{if {=MOD({={page}/2};1)} > 0 {=({page}+1)/2}}" ""}
[/vba]

Автор - krosav4ig
Дата добавления - 22.07.2019 в 12:57
krosav4ig Дата: Вторник, 23.07.2019, 14:46 | Сообщение № 2108 | Тема: Группировка строк с объединением и суммирование данных
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Вариант в Power Query
[vba]
Код
let
    Source = Excel.CurrentWorkbook(){[Name="data"]}[Content],
    Group = Table.Group(Source, {"Column1", "Column3", "Column4","Column5","Column7"}, {{"Column2", each Text.Combine(List.Transform([Column2],Text.From),","), type text},{"Column6", each List.Sum([Column6]), type number}})
in
    Table.ReorderColumns(Group,Table.ColumnNames(Source))
[/vba]
данные для запроса берутся из именованного диапазона data, для обновления ПКМ по таблице>Обновить или Данные>Обновить все (Ctrl+Alt+F5)
К сообщению приложен файл: 9309715.xlsx (18.6 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеВариант в Power Query
[vba]
Код
let
    Source = Excel.CurrentWorkbook(){[Name="data"]}[Content],
    Group = Table.Group(Source, {"Column1", "Column3", "Column4","Column5","Column7"}, {{"Column2", each Text.Combine(List.Transform([Column2],Text.From),","), type text},{"Column6", each List.Sum([Column6]), type number}})
in
    Table.ReorderColumns(Group,Table.ColumnNames(Source))
[/vba]
данные для запроса берутся из именованного диапазона data, для обновления ПКМ по таблице>Обновить или Данные>Обновить все (Ctrl+Alt+F5)

Автор - krosav4ig
Дата добавления - 23.07.2019 в 14:46
krosav4ig Дата: Вторник, 23.07.2019, 18:34 | Сообщение № 2109 | Тема: Сортировка элементов Collection перед выгрузкой на лист
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Вариант с Arraylist

[vba]
Код
Sub элемент_таблицы()
    Dim myRange As Range, myCell As Range, AL As Object, v As Variant, r As Variant, _
    myElement As Variant, i As Long, smyRange As Range, ssmyRange As Range
    Dim LastRow
    Dim sLastRow
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    LastRow = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, 1).End(xlUp).Row
    sLastRow = Sheets("Лист3").Cells(Sheets("Лист3").Rows.Count, 1).End(xlUp).Row
    Set myRange = Sheets("Лист2").Range("A2:A" & LastRow)
    Set ssmyRange = Sheets("Лист3").Range("A2:A" & sLastRow)
    On Error Resume Next
    
    Set AL = CreateObject("system.Collections.Arraylist")

    For Each r In Array(myRange, ssmyRange)
        For Each v In r.Value
            If Not IsEmpty(v) And Not AL.contains(v) Then AL.Add v
    Next v, r
    AL.Sort

    On Error GoTo 0
    [проба!J2].Resize(, AL.Count) = AL.toarray
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеВариант с Arraylist

[vba]
Код
Sub элемент_таблицы()
    Dim myRange As Range, myCell As Range, AL As Object, v As Variant, r As Variant, _
    myElement As Variant, i As Long, smyRange As Range, ssmyRange As Range
    Dim LastRow
    Dim sLastRow
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    LastRow = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, 1).End(xlUp).Row
    sLastRow = Sheets("Лист3").Cells(Sheets("Лист3").Rows.Count, 1).End(xlUp).Row
    Set myRange = Sheets("Лист2").Range("A2:A" & LastRow)
    Set ssmyRange = Sheets("Лист3").Range("A2:A" & sLastRow)
    On Error Resume Next
    
    Set AL = CreateObject("system.Collections.Arraylist")

    For Each r In Array(myRange, ssmyRange)
        For Each v In r.Value
            If Not IsEmpty(v) And Not AL.contains(v) Then AL.Add v
    Next v, r
    AL.Sort

    On Error GoTo 0
    [проба!J2].Resize(, AL.Count) = AL.toarray
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 23.07.2019 в 18:34
krosav4ig Дата: Вторник, 23.07.2019, 20:10 | Сообщение № 2110 | Тема: Сортировка элементов Collection перед выгрузкой на лист
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
надо выгружать в строку

mss, а если, вдруг, количество уникальных значений будет >4^7 ?


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
надо выгружать в строку

mss, а если, вдруг, количество уникальных значений будет >4^7 ?

Автор - krosav4ig
Дата добавления - 23.07.2019 в 20:10
krosav4ig Дата: Среда, 24.07.2019, 23:17 | Сообщение № 2111 | Тема: Сопоставление и группировка двух диапазонов данных
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Вариант в Power Query[vba]
Код
let
    fn=(t)=>let
        Col = Table.ColumnNames(t),
        GroupBy = List.RemoveMatchingItems(Col,{Col{1},Col{5}}),
        List    = {{Col{1}, each Text.Combine(List.Transform(Table.Column(_,Col{1}),Text.From),",")},
                   {Col{5}, each List.Sum(Table.Column(_,Col{5}))}}
    in Table.ReorderColumns(Table.Group(t,GroupBy,List),Col),    
    Source    = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    Source1   = Excel.CurrentWorkbook(){[Name="Таблица2"]}[Content],
    Merge     = Table.NestedJoin(fn(Source),{"Столбец1","Столбец4"},fn(Source1),{"Столбец1","Столбец4"},"2",3),
    Group     = Table.Group(Merge, {"2"}, {{"1", each Table.RemoveColumns(_,{"2"}), type table}})[[1],[2]],
    Transform = Table.FromRecords(Table.TransformRows(Group,(r)=>
                    Record.TransformFields(r,{
                        {"1",each Table.ReplaceValue(_,null,r[2]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})},
                        {"2",each Table.ReplaceValue(_,null,r[1]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})}
                    }))),
    ColN      = List.Zip(List.Transform(Table.ColumnNames(Source),each {_,"1."&_,"2."&_})),
    Result    = Table.ExpandTableColumn(Table.ExpandTableColumn(Transform, "1", ColN{0}, ColN{1}),"2", ColN{0}, ColN{2})
in
    Result
[/vba]
К сообщению приложен файл: 8954645.xlsx (34.8 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеВариант в Power Query[vba]
Код
let
    fn=(t)=>let
        Col = Table.ColumnNames(t),
        GroupBy = List.RemoveMatchingItems(Col,{Col{1},Col{5}}),
        List    = {{Col{1}, each Text.Combine(List.Transform(Table.Column(_,Col{1}),Text.From),",")},
                   {Col{5}, each List.Sum(Table.Column(_,Col{5}))}}
    in Table.ReorderColumns(Table.Group(t,GroupBy,List),Col),    
    Source    = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    Source1   = Excel.CurrentWorkbook(){[Name="Таблица2"]}[Content],
    Merge     = Table.NestedJoin(fn(Source),{"Столбец1","Столбец4"},fn(Source1),{"Столбец1","Столбец4"},"2",3),
    Group     = Table.Group(Merge, {"2"}, {{"1", each Table.RemoveColumns(_,{"2"}), type table}})[[1],[2]],
    Transform = Table.FromRecords(Table.TransformRows(Group,(r)=>
                    Record.TransformFields(r,{
                        {"1",each Table.ReplaceValue(_,null,r[2]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})},
                        {"2",each Table.ReplaceValue(_,null,r[1]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})}
                    }))),
    ColN      = List.Zip(List.Transform(Table.ColumnNames(Source),each {_,"1."&_,"2."&_})),
    Result    = Table.ExpandTableColumn(Table.ExpandTableColumn(Transform, "1", ColN{0}, ColN{1}),"2", ColN{0}, ColN{2})
in
    Result
[/vba]

Автор - krosav4ig
Дата добавления - 24.07.2019 в 23:17
krosav4ig Дата: Четверг, 25.07.2019, 08:10 | Сообщение № 2112 | Тема: Kонвертация Power Point в Pdf
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
у меня получилось только с ранним связыванием

[vba]
Код
Sub test()
    On Error Resume Next
    ThisWorkbook.VBProject.References.AddFromFile Application.Path & "\MSPPT.OLB"
    On Error GoTo 0
    Dim pp As New PowerPoint.Application
    With pp.Presentations.Open(Environ("userprofile") & "\Documents\Презентация1.pptx")
        .ExportAsFixedFormat .Path & "\test.pdf", 2&, 2&
        .Close
    End With
    If pp.Presentations.Count = 0 Then pp.Quit
    Set pp = Nothing
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеу меня получилось только с ранним связыванием

[vba]
Код
Sub test()
    On Error Resume Next
    ThisWorkbook.VBProject.References.AddFromFile Application.Path & "\MSPPT.OLB"
    On Error GoTo 0
    Dim pp As New PowerPoint.Application
    With pp.Presentations.Open(Environ("userprofile") & "\Documents\Презентация1.pptx")
        .ExportAsFixedFormat .Path & "\test.pdf", 2&, 2&
        .Close
    End With
    If pp.Presentations.Count = 0 Then pp.Quit
    Set pp = Nothing
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 25.07.2019 в 08:10
krosav4ig Дата: Четверг, 25.07.2019, 12:05 | Сообщение № 2113 | Тема: Kонвертация Power Point в Pdf
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
а все потому, что Excel зачем-то пытался выполнить свой ExportAsFixedFormat


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеа все потому, что Excel зачем-то пытался выполнить свой ExportAsFixedFormat

Автор - krosav4ig
Дата добавления - 25.07.2019 в 12:05
krosav4ig Дата: Четверг, 25.07.2019, 12:10 | Сообщение № 2114 | Тема: Автозаполнение с поворотом
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте

Ctrl+C
Ctrl+Alt+V
Alt+F
Enter


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте

Ctrl+C
Ctrl+Alt+V
Alt+F
Enter

Автор - krosav4ig
Дата добавления - 25.07.2019 в 12:10
krosav4ig Дата: Четверг, 25.07.2019, 21:09 | Сообщение № 2115 | Тема: Kонвертация Power Point в Pdf
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
а чтоб срабатывала надо в окне книги Alt+ЕМБ и поставить галочку Предоставлять доступ...


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеа чтоб срабатывала надо в окне книги Alt+ЕМБ и поставить галочку Предоставлять доступ...

Автор - krosav4ig
Дата добавления - 25.07.2019 в 21:09
krosav4ig Дата: Суббота, 27.07.2019, 14:51 | Сообщение № 2116 | Тема: Сопоставление и группировка двух диапазонов данных
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
1. в запросе в двух местах заменить [vba]
Код
{"Столбец1","Столбец4"}
[/vba] на [vba]
Код
{"Столбец1","Столбец4","Столбец8"}
[/vba]
2. ПКМ по ячейке итоговой таблицы > Обновить. Или Данные > Обновить все (Ctrl+Alt+F5)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Суббота, 27.07.2019, 14:51
 
Ответить
Сообщение1. в запросе в двух местах заменить [vba]
Код
{"Столбец1","Столбец4"}
[/vba] на [vba]
Код
{"Столбец1","Столбец4","Столбец8"}
[/vba]
2. ПКМ по ячейке итоговой таблицы > Обновить. Или Данные > Обновить все (Ctrl+Alt+F5)

Автор - krosav4ig
Дата добавления - 27.07.2019 в 14:51
krosav4ig Дата: Вторник, 30.07.2019, 17:05 | Сообщение № 2117 | Тема: Выпадающий список без блокировки ручного ввода
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
вариант с UDF c автонаполнением списка
в диспетчере имен именованная формула список
Код
=DropDownList(Sheet1!$B$42)

в проверке данных Источник
Код
=Список
, будет ругаться на ошибку, жмем ок
Сообщение об ошибке можно не отключать
[vba]
Код

Function DropDownList(r As Range) As Range
    
    Dim r0 As Range, r1 As Range
    Static b As Boolean

    If b Then: b = False: Exit Function
   
    Application.Volatile False
    Set r0 = Application.Caller
    If IsEmpty(r(2)) Then
        Set r1 = r
    Else
        Set r1 = r.Parent.Range(r, r.End(xlDown))
    End If
    Set DropDownList = r1
    If r1.Find(r0, , xlValues, xlWhole) Is Nothing And Not IsEmpty(r0) Then
        If MsgBox("Введеное начение не надено." & vbCr & _
                  "Добавить его в cписок?", vbQuestion Or vbYesNo) = vbYes Then
            r1.Offset(r1.Rows.Count)(1, 1) = r0
        Else
            b = True: Exit Function
        End If
    End If
End Function
[/vba]
К сообщению приложен файл: 2065150.xls (72.0 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 30.07.2019, 21:58
 
Ответить
Сообщениевариант с UDF c автонаполнением списка
в диспетчере имен именованная формула список
Код
=DropDownList(Sheet1!$B$42)

в проверке данных Источник
Код
=Список
, будет ругаться на ошибку, жмем ок
Сообщение об ошибке можно не отключать
[vba]
Код

Function DropDownList(r As Range) As Range
    
    Dim r0 As Range, r1 As Range
    Static b As Boolean

    If b Then: b = False: Exit Function
   
    Application.Volatile False
    Set r0 = Application.Caller
    If IsEmpty(r(2)) Then
        Set r1 = r
    Else
        Set r1 = r.Parent.Range(r, r.End(xlDown))
    End If
    Set DropDownList = r1
    If r1.Find(r0, , xlValues, xlWhole) Is Nothing And Not IsEmpty(r0) Then
        If MsgBox("Введеное начение не надено." & vbCr & _
                  "Добавить его в cписок?", vbQuestion Or vbYesNo) = vbYes Then
            r1.Offset(r1.Rows.Count)(1, 1) = r0
        Else
            b = True: Exit Function
        End If
    End If
End Function
[/vba]

Автор - krosav4ig
Дата добавления - 30.07.2019 в 17:05
krosav4ig Дата: Вторник, 30.07.2019, 21:59 | Сообщение № 2118 | Тема: Выпадающий список без блокировки ручного ввода
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
дополнил код в своем посте, не учел один ньюанс


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениедополнил код в своем посте, не учел один ньюанс

Автор - krosav4ig
Дата добавления - 30.07.2019 в 21:59
krosav4ig Дата: Вторник, 30.07.2019, 23:51 | Сообщение № 2119 | Тема: копирование имени листа в каждую непустую строку
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Добрый вечер
[vba]
Код
Sub sdf()
    Dim v As Variant, ar As Range
    On Error Resume Next
    With ActiveSheet.UsedRange
        With Intersect(.Offset(4 - .Row), .Cells)
            For Each v In Array(xlCellTypeFormulas, xlCellTypeConstants)
                For Each ar In .SpecialCells(v, 23).EntireRow.Areas
                    Intersect(ar, .Parent.[B:B]).Value = .Parent.Name
            Next ar, v
        End With
    End With
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 30.07.2019, 23:52
 
Ответить
СообщениеДобрый вечер
[vba]
Код
Sub sdf()
    Dim v As Variant, ar As Range
    On Error Resume Next
    With ActiveSheet.UsedRange
        With Intersect(.Offset(4 - .Row), .Cells)
            For Each v In Array(xlCellTypeFormulas, xlCellTypeConstants)
                For Each ar In .SpecialCells(v, 23).EntireRow.Areas
                    Intersect(ar, .Parent.[B:B]).Value = .Parent.Name
            Next ar, v
        End With
    End With
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 30.07.2019 в 23:51
krosav4ig Дата: Среда, 31.07.2019, 00:12 | Сообщение № 2120 | Тема: Сопоставление и группировка двух диапазонов данных
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
WERDART, у вас на листе ресурс 2 таблица не растянулась на столбец 8
[vba]
Код
let
    fn=(t)=>let
        Col     = Table.ColumnNames(t),
        GroupBy = List.RemoveMatchingItems(Col,{Col{1},Col{5}}),
        List    = {{Col{1}, each Text.Combine(List.Transform(Table.Column(_,Col{1}),Text.From),",")},
                   {Col{5}, each List.Sum(Table.Column(_,Col{5}))}}
    in Table.ReorderColumns(Table.Group(t,GroupBy,List),Col),    
    Source    = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    Source1   = Excel.CurrentWorkbook(){[Name="Таблица2"]}[Content],
    Merge     = Table.NestedJoin(fn(Source),{"Столбец1","Столбец4","Столбец8"},fn(Source1),{"Столбец1","Столбец4","Столбец8"},"2",3),
    Group     = Table.Group(Merge, {"2"}, {{"1", each Table.RemoveColumns(_,{"2"}), type table}})[[1],[2]],
    Transform = Table.FromRecords(Table.TransformRows(Group,(r)=>
                    Record.TransformFields(r,{
                        {"1",each Table.ReplaceValue(_,null,r[2]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})},
                        {"2",each Table.ReplaceValue(_,null,r[1]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})}
                    }))),
    ColN      = List.Zip(List.Transform(Table.ColumnNames(Source),each {_,"1."&_,"2."&_})),
    Result    = Table.ExpandTableColumn(Table.ExpandTableColumn(Transform, "1", ColN{0}, ColN{1}),"2", ColN{0}, ColN{2})
in
    Result
[/vba]
К сообщению приложен файл: 5678766.xlsx (37.7 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеWERDART, у вас на листе ресурс 2 таблица не растянулась на столбец 8
[vba]
Код
let
    fn=(t)=>let
        Col     = Table.ColumnNames(t),
        GroupBy = List.RemoveMatchingItems(Col,{Col{1},Col{5}}),
        List    = {{Col{1}, each Text.Combine(List.Transform(Table.Column(_,Col{1}),Text.From),",")},
                   {Col{5}, each List.Sum(Table.Column(_,Col{5}))}}
    in Table.ReorderColumns(Table.Group(t,GroupBy,List),Col),    
    Source    = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    Source1   = Excel.CurrentWorkbook(){[Name="Таблица2"]}[Content],
    Merge     = Table.NestedJoin(fn(Source),{"Столбец1","Столбец4","Столбец8"},fn(Source1),{"Столбец1","Столбец4","Столбец8"},"2",3),
    Group     = Table.Group(Merge, {"2"}, {{"1", each Table.RemoveColumns(_,{"2"}), type table}})[[1],[2]],
    Transform = Table.FromRecords(Table.TransformRows(Group,(r)=>
                    Record.TransformFields(r,{
                        {"1",each Table.ReplaceValue(_,null,r[2]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})},
                        {"2",each Table.ReplaceValue(_,null,r[1]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})}
                    }))),
    ColN      = List.Zip(List.Transform(Table.ColumnNames(Source),each {_,"1."&_,"2."&_})),
    Result    = Table.ExpandTableColumn(Table.ExpandTableColumn(Transform, "1", ColN{0}, ColN{1}),"2", ColN{0}, ColN{2})
in
    Result
[/vba]

Автор - krosav4ig
Дата добавления - 31.07.2019 в 00:12
Мир MS Excel » Записи участника » krosav4ig [2347]
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!