В столбце В есть ячейки содержащие "значения-слова" целиком (без лишних символов и пробелов). Нужно уникальные "значения-слова" вставить через запятую + пробел (кроме последнего или кроме случая, если значение-слово одно) в столбец F во вторую строку после последней заполненной ячейки в этом же F столбце. значения-слова известны и неизменны: "A";"AB...AP";"GH";"I";"KK";"L";"MC2-MN2-MN3-MN4-MP2-MU2-MZ2-MA2-MC7-MP7";"M";"NN";"W" Пытался через формулу СУММЕСЛИ
В столбце В есть ячейки содержащие "значения-слова" целиком (без лишних символов и пробелов). Нужно уникальные "значения-слова" вставить через запятую + пробел (кроме последнего или кроме случая, если значение-слово одно) в столбец F во вторую строку после последней заполненной ячейки в этом же F столбце. значения-слова известны и неизменны: "A";"AB...AP";"GH";"I";"KK";"L";"MC2-MN2-MN3-MN4-MP2-MU2-MZ2-MA2-MC7-MP7";"M";"NN";"W" Пытался через формулу СУММЕСЛИ
Спасибо большое. Ячейку для ввода формулы определяю так: [vba]
Код
With Cells(Cells.Rows.Count, 3).End(xlUp).Offset(3, 3) .FormulaR1C1 = "=@JoinWithoutDuplicates(R[-22]C[-4]:RC[-4],"", "")" .Copy .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End With
[/vba] Функция отрабатывает чётко, но я не могу учесть верхнюю (R[-22]C[-4]) и нижнюю (RC[-4]) ячейки массива для формулы, т.к. иногда "борода" в рабочем файле имеет различное количество строк. Сейчас попробую через переменные, с последующей подставкой в тело формулы (вчера похожее делал с разбиением формулы на несколько частей, типа: [vba]
Спасибо большое. Ячейку для ввода формулы определяю так: [vba]
Код
With Cells(Cells.Rows.Count, 3).End(xlUp).Offset(3, 3) .FormulaR1C1 = "=@JoinWithoutDuplicates(R[-22]C[-4]:RC[-4],"", "")" .Copy .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False End With
[/vba] Функция отрабатывает чётко, но я не могу учесть верхнюю (R[-22]C[-4]) и нижнюю (RC[-4]) ячейки массива для формулы, т.к. иногда "борода" в рабочем файле имеет различное количество строк. Сейчас попробую через переменные, с последующей подставкой в тело формулы (вчера похожее делал с разбиением формулы на несколько частей, типа: [vba]
Очень пытался подружиться с функциями. Разнес их по разным модулям. Вчера отрабатывало все отлично, а сегодня формула, содержащая функцию работает лишь в файле с модулями функции (и макроса), а когда работаю в простом .xlsx и вызываю функцию из стороннего файла "каталога макросов", то функция не подтягивается. Перезагружался... Вероятно я что-либо не так делаю. Либо через надстройки нужно запускать, подскажите, пожалуйста?
Очень пытался подружиться с функциями. Разнес их по разным модулям. Вчера отрабатывало все отлично, а сегодня формула, содержащая функцию работает лишь в файле с модулями функции (и макроса), а когда работаю в простом .xlsx и вызываю функцию из стороннего файла "каталога макросов", то функция не подтягивается. Перезагружался... Вероятно я что-либо не так делаю. Либо через надстройки нужно запускать, подскажите, пожалуйста?timo64uk
timo64uk, Добрый день. Вам нужно перенести модуль VBA из файла с функцией в ваш файл. Открываете оба файла, нажимаете ALT+F11, в окне VBA в правом окне под именем файла с функцией увидите "Модуль 1". Наведите на него курсор, зажмите ЛКМ и перетащите на ваш новый файл. Все, эта фукция будет в вашем файле, не забудьте сохранить его в формате с поддержкой макросов.
timo64uk, Добрый день. Вам нужно перенести модуль VBA из файла с функцией в ваш файл. Открываете оба файла, нажимаете ALT+F11, в окне VBA в правом окне под именем файла с функцией увидите "Модуль 1". Наведите на него курсор, зажмите ЛКМ и перетащите на ваш новый файл. Все, эта фукция будет в вашем файле, не забудьте сохранить его в формате с поддержкой макросов.i691198
timo64uk, Удобнее переносить модуль с кодом не в свой файл (где будете использовать), а вот именно в подключенную НАДСТРОЙКУ - тогда сможете использовать всюду (у себя) как любую встроенную функцию.
timo64uk, Удобнее переносить модуль с кодом не в свой файл (где будете использовать), а вот именно в подключенную НАДСТРОЙКУ - тогда сможете использовать всюду (у себя) как любую встроенную функцию.Hugo
Спасибо за пояснения. Прошу с кодом помочь. На основе двух недавно рассмотренных на данном форуме, в рамках данной темы. [vba]
Код
Dim r1_ As Variant ' номер строки по столбцу 3 последний заполненный Dim au As Variant 'массив в столбце В из которого выбираем значения Dim bu As Variant 'разделитель ", " после вставки в eu Dim eu As Variant ' ячейка для вставки уникальных значений из массива столбца С Dim cu As Variant, du As Variant ActiveSheet.UsedRange 'сбросить результат с последней ячейкой, строкой r1_ = Cells(Rows.Count, 3).End(xlUp).Row 'номер последней используемой строки ar_ = Cells(1, 3).Resize(r1_).Value 'в массив все от С1 вниз на r1_ t_ = "от Заказчика / Owner" 'текст для поиска For i = r1_ To 1 Step -1 'цикл от r1_ до 1 If ar_(i, 1) = t_ Then 'если элемент массива с номером i равен тексту для поиска fl_ = 1 'флаг равен 1 au = Cells(i + 1, 2).Resize(r1_ - i) '.Select 'здесь ??? Exit For 'Заканчиваем цикл End If ' окончание if Next i 'окончание цикла If fl_ <> 1 Then 'если флаг не =1 (мы не нашли искомый текст) MsgBox "Текст ''" & t_ & "'' не найден в столбце С." 'выводим об этом сообщение End If ' bu = ", " 'если в подряд bu = ", " а , если в столбец в одну ячейку, как в реестр bu = "," & Chr(10) eu = "" For Each cu In au '.Rows '.Cells 'здесь ??? For Each cu In Range("C8:C" & au).SpecialCells(xlCellTypeConstants, 23) du = cu.Row If du = r1_ Then bu = "" eu = eu & cu.Value & bu Next eu = Cells(Cells.Rows.Count, 3).End(xlUp).Offset(3, 3)
[/vba] Не могу эту строку победить For Each cu In au (в остальном, конечно тоже не очень уверен, но тут прям перепробовал всё известное). Он пока не убирает дубли (под это у меня есть 3ий код не адаптированный ещё.
[vba]
Код
' Удалим дубли из C14 COR-P3-RSR- ''' Dim co As Range, xo, nbsp$ ''' nbsp = Chr$(160) ''' With CreateObject("scripting.dictionary") ''' For Each co In Sheets("COR-P3-RSR-").Range("C14") ''' .RemoveAll ''' For Each xo In Split(Application.Trim(Replace$(co, nbsp, " ")), ",") ''' xo = Trim(xo) ''' .Item(xo) = 0 ''' Next ''' co = Join(.keys, ", ") ''' Next ''' End With
[/vba]
Спасибо за пояснения. Прошу с кодом помочь. На основе двух недавно рассмотренных на данном форуме, в рамках данной темы. [vba]
Код
Dim r1_ As Variant ' номер строки по столбцу 3 последний заполненный Dim au As Variant 'массив в столбце В из которого выбираем значения Dim bu As Variant 'разделитель ", " после вставки в eu Dim eu As Variant ' ячейка для вставки уникальных значений из массива столбца С Dim cu As Variant, du As Variant ActiveSheet.UsedRange 'сбросить результат с последней ячейкой, строкой r1_ = Cells(Rows.Count, 3).End(xlUp).Row 'номер последней используемой строки ar_ = Cells(1, 3).Resize(r1_).Value 'в массив все от С1 вниз на r1_ t_ = "от Заказчика / Owner" 'текст для поиска For i = r1_ To 1 Step -1 'цикл от r1_ до 1 If ar_(i, 1) = t_ Then 'если элемент массива с номером i равен тексту для поиска fl_ = 1 'флаг равен 1 au = Cells(i + 1, 2).Resize(r1_ - i) '.Select 'здесь ??? Exit For 'Заканчиваем цикл End If ' окончание if Next i 'окончание цикла If fl_ <> 1 Then 'если флаг не =1 (мы не нашли искомый текст) MsgBox "Текст ''" & t_ & "'' не найден в столбце С." 'выводим об этом сообщение End If ' bu = ", " 'если в подряд bu = ", " а , если в столбец в одну ячейку, как в реестр bu = "," & Chr(10) eu = "" For Each cu In au '.Rows '.Cells 'здесь ??? For Each cu In Range("C8:C" & au).SpecialCells(xlCellTypeConstants, 23) du = cu.Row If du = r1_ Then bu = "" eu = eu & cu.Value & bu Next eu = Cells(Cells.Rows.Count, 3).End(xlUp).Offset(3, 3)
[/vba] Не могу эту строку победить For Each cu In au (в остальном, конечно тоже не очень уверен, но тут прям перепробовал всё известное). Он пока не убирает дубли (под это у меня есть 3ий код не адаптированный ещё.
[vba]
Код
' Удалим дубли из C14 COR-P3-RSR- ''' Dim co As Range, xo, nbsp$ ''' nbsp = Chr$(160) ''' With CreateObject("scripting.dictionary") ''' For Each co In Sheets("COR-P3-RSR-").Range("C14") ''' .RemoveAll ''' For Each xo In Split(Application.Trim(Replace$(co, nbsp, " ")), ",") ''' xo = Trim(xo) ''' .Item(xo) = 0 ''' Next ''' co = Join(.keys, ", ") ''' Next ''' End With
Sub tt() ActiveSheet.UsedRange r1_ = Cells(Rows.Count, 3).End(xlUp).Row ar_ = Cells(1, 3).Resize(r1_).Value t_ = "от Заказчика / Owner" For i = r1_ To 1 Step -1 If ar_(i, 1) = t_ Then If i < r1_ Then nr_ = r1_ - i fl_ = 1 ar1_ = Cells(i + 1, 2).Resize(nr_).Value del_ = ", " Set slov = CreateObject("scripting.dictionary") With slov For j = 1 To UBound(ar1_) z_ = ar1_(j, 1) If z_ <> "" Then If Not .exists(z_) Then aaa = .Item(z_) End If End If Next j x_ = Join(.keys, del_) End With Cells(r1_ + 3, 6) = x_ End If Exit For End If Next i If fl_ <> 1 Then MsgBox "Текст ''" & t_ & "'' не найден в столбце С." Exit Sub End If ' End Sub
[/vba]
[vba]
Код
Sub tt() ActiveSheet.UsedRange r1_ = Cells(Rows.Count, 3).End(xlUp).Row ar_ = Cells(1, 3).Resize(r1_).Value t_ = "от Заказчика / Owner" For i = r1_ To 1 Step -1 If ar_(i, 1) = t_ Then If i < r1_ Then nr_ = r1_ - i fl_ = 1 ar1_ = Cells(i + 1, 2).Resize(nr_).Value del_ = ", " Set slov = CreateObject("scripting.dictionary") With slov For j = 1 To UBound(ar1_) z_ = ar1_(j, 1) If z_ <> "" Then If Not .exists(z_) Then aaa = .Item(z_) End If End If Next j x_ = Join(.keys, del_) End With Cells(r1_ + 3, 6) = x_ End If Exit For End If Next i If fl_ <> 1 Then MsgBox "Текст ''" & t_ & "'' не найден в столбце С." Exit Sub End If ' End Sub
Спасибо большое. Думал как не воспринимать пустые ячейки из массива-донора, а то лишние запятые-пробелы из "моего" кода вылазили. ***
Сейчас перечитал тему и не обнаружил упоминаний о том, что слов-индикаторов (из примера это "от Заказчика / Owner") может быть несколько, определяющих верхнюю границу массива для отбора значений. И ранее мне известные способы определения данного массива не подходили, т.к. выбирали самое верхнее слово-индикатор. Однако все коды представленные в теме выбирают именно нужный массив. Спасибо ещё раз всем.
Спасибо большое. Думал как не воспринимать пустые ячейки из массива-донора, а то лишние запятые-пробелы из "моего" кода вылазили. ***
Сейчас перечитал тему и не обнаружил упоминаний о том, что слов-индикаторов (из примера это "от Заказчика / Owner") может быть несколько, определяющих верхнюю границу массива для отбора значений. И ранее мне известные способы определения данного массива не подходили, т.к. выбирали самое верхнее слово-индикатор. Однако все коды представленные в теме выбирают именно нужный массив. Спасибо ещё раз всем.timo64uk
Сообщение отредактировал timo64uk - Суббота, 16.11.2024, 03:25