Страницы: 1
RSS
как все значения больше 10 из одного ряда собрать в одну ячейку, как все значения больше 10 из одного ряда собрать в одну ячейку
 
Добрый день. Подскажите как все значения "больше 10" из одного ряда собрать в одну ячейку? Спасибо.  
 
Цитата
mayer4 написал:
собрать в одну ячейку
А как должен выглядеть результат?
 
В ячейке AT все подходящие значения через запятую по каждой строке.
 
Код
Sub Macro1()
Dim LastRow As Long, i As Long, j As Long, Arr()
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Arr = Range(Cells(3, 2), Cells(LastRow, 45)).Value
    ReDim arr2(1 To UBound(Arr), 1 To 1)
    For i = 1 To UBound(Arr)
        For j = 1 To UBound(Arr, 2)
            If Arr(i, j) > 10 Then
                If arr2(i, 1) = "" Then
                    arr2(i, 1) = Arr(i, j)
                Else
                    arr2(i, 1) = arr2(i, 1) & ", " & Arr(i, j)
                End If
            End If
        Next
    Next
    Range("AT3").Resize(UBound(Arr), 1).Value = arr2
End Sub

 
Спасибо!!! А возможно-ли сделать без использования макросов или без них не обойтись?
 
Ждите формулистов )
 
А как можно изменить макрос чтобы искать данные в таблице с большим количеством значений (число рядов если увеличивается до 288)?
 
Рядов = столбцов?
 
Да!!!
 
Такой вариант сам определит размеры:
Код
Sub Macro1()
Dim LastRow As Long, i As Long, j As Long, Arr(), LastColumn As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    LastColumn = Cells(3, Columns.Count).End(xlToLeft).Column
    Arr = Range(Cells(3, 2), Cells(LastRow, LastColumn)).Value
    ReDim arr2(1 To UBound(Arr), 1 To 1)
    For i = 1 To UBound(Arr)
        For j = 1 To UBound(Arr, 2)
            If Arr(i, j) > 10 Then
                If arr2(i, 1) = "" Then
                    arr2(i, 1) = Arr(i, j)
                Else
                    arr2(i, 1) = arr2(i, 1) & ", " & Arr(i, j)
                End If
            End If
        Next
    Next
    Cells(3, LastColumn + 1).Resize(UBound(Arr), 1).Value = arr2
End Sub


 
Может что-то не так делаю?
 
У Вас неправильно определяется номер последнего столбца. В первом варианте данные начинались с третьей строки - по ней я и определял. А теперь данные начинаются со второй строки и идут с перерывами. Поменяйте так.
Код
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'    LastColumn = Cells(3, Columns.Count).End(xlToLeft).Column
    LastColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Arr = Range(Cells(2, 2), Cells(LastRow, LastColumn)).Value


Но самая беда в том, что пустые ячейки у Вас по факту не являются пустыми. Следует выделить диапазон, нажать Delete, и после этого заполнить данными.
 
Заменил все пустые ячейки на ячейки со значением "0".
 
Проще было занести данные на новый (чистый лист).
См. пример и комментарии в коде.
 
Спасибо, все работает!!!
 
Добрый день. Хотелось бы уточнить у "формулистов" возможно ли решить данную задачу посредством формул? Спасибо!
 
mayer4, если у вас Excel 2019 или Office365, то всё делается просто с помощью такой формулы массива:

=ОБЪЕДИНИТЬ(",";ИСТИНА;ЕСЛИ(B3:AS3>10;B3:AS3;""))
 
К сожалению Excel 2010 (((
Страницы: 1
Наверх