Страницы: 1
RSS
Сцепить ячейки до последней заполненной строки
 
Здравствуйте, прошу подсказать как можно сцепить ячейки до последней заполненной строки.
У меня есть код, но на большом количестве ячеек он работает долго, можно ли сцеплять ячейки быстрее?
Код
Sub сцепить() 
     Application.ScreenUpdating = False
    For a = 2 To Cells(Rows.Count, 3).End(xlUp).Row
        a2 = Cells(Rows.Count, 8).End(xlUp).Row + 1
         Cells(a2, 8) = (Cells(a, 3) & Cells(a, 4) & Cells(a, 5) & Cells(a, 6))
    Next
     Application.ScreenUpdating = True
End Sub
 
Kislota,
попробуйте так:
Код
Sub aaa()
     Application.ScreenUpdating = False
     Application.Calculation = xlCalculationManual
    [H:H].ClearContents
    For a = 2 To Cells(Rows.Count, 3).End(xlUp).Row
        a2 = Cells(Rows.Count, 8).End(xlUp).Row + 1
         Cells(a2, 8) = (Cells(a, 3) & Cells(a, 4) & Cells(a, 5) & Cells(a, 6))
    Next
     Application.ScreenUpdating = True
     Application.Calculation = xlCalculationAutomatic
End Sub
или тупо так:
Код
Sub Макрос1()
Application.ScreenUpdating = False
    a = Cells(Rows.Count, 3).End(xlUp).Row
    Cells(2, 8) = "=CONCAT(TEXT(RC[-5],""ДД.ММ.ГГГГ""),RC[-4]:RC[-2])"
    Cells(2, 8).Copy Range(Cells(2, 8), Cells(a, 8))
    Range(Cells(2, 8), Cells(a, 8)).Formula = Range(Cells(2, 8), Cells(a, 8)).Value
Application.ScreenUpdating = True
End Sub
можно использовать формулу:
Код
=СЦЕП(ТЕКСТ(C2;"ДД.ММ.ГГГГ");D2:F2)
Изменено: evgeniygeo - 13.07.2021 10:17:59
 
Код
Sub qq()
    Dim ar
    ar = Range(Cells(2, 2), Cells(Cells(Rows.Count, 3).End(xlUp).Row, 6)).Value
    [H:H].ClearContents
    For i = 1 To UBound(ar)
        ar(i, 1) = ar(i, 2) & ar(i, 3) & ar(i, 4) & ar(i, 5)
    Next
    [H2].Resize(UBound(ar)).Value = ar
End Sub
 
evgeniygeo, RAN , благодарю Вас за ответы, работает очень быстро.
 
Kislota,
вариант господина RAN пошустрее будет  ;)  
Страницы: 1
Наверх