Страницы: 1
RSS
Объединенить / СЦЕПИТЬ ячееки в умной таблице, macro, vba
 
Только тут могут помочь, направить.
Задача. Сцепить ячейки в умной таблице. Данные нужно сцепить между двумя колонками. Start и End. Позиция  End колонки постоянно меняется от листа к листу. Данные нужно вывести в колонку Start.  Пример прикреплен. Там есть корявенький макрос. Пытался что-то придумать.
Спасибо и хороших выходных!
 
8) Вы написали этот код, и не знаете, как это сделать дальше ? 8)  ... вот шутник из вас ...  ;)  
 
Цитата
ocet p написал:
вот шутник из вас
Вообще не претендую на авторство кода. Нашел там, где и многие находят :). Да, пытался адаптировать. Не вышел каменный цветок ;)

Буду признателен любой помощи.
Спасибо.
Изменено: Alex D - 29.02.2020 14:57:30
 
Цитата
Alex D написал:
End колонки постоянно меняется от листа к листу
Значит,  это надо сделать для многих листов, а не только для одного ?
 
Цитата
ocet p написал:
не только для одного ?
Так точно. Листов около 20-30, их количесво так же меняется.
 
Alex D, Добрый день. Сильно не вникал. Просто подправил ваш код, чтобы работал
 
Спасибо что помогли. Код цепляет и End колонку, но тут я думаю уже разберусь сам. Надеюсь :)
Еще раз спасибо большое!
 
Alex D, В   коде макроса есть и вариант  без колонки End
Изменено: casag - 01.03.2020 16:10:10
 
Цитата
casag написал:
без колонки End
Огромное спасибо!!! Не обратил внимание. Все отлично работает!  По листам докручу сам и оставлю тут. Мало-ли кому пригодится!
Отличных Вам дня!

Строго не судите. Еще раз спасибо за помощь!
Код
Sub concat_test()
    Dim xWs As Worksheet
    Dim lo As ListObject
    Dim iColStart As Long
    Dim iColEnd As Long
    
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "sheet_name_1" And xWs.Name <> "sheet_name_2" Then
        xWs.Activate
            
            Set xWs = ActiveSheet
            Set lo = ActiveSheet.ListObjects(1)
            
            Dim resultString As String
            Dim LastRow As Integer: LastRow = Range(lo).Find("*", , xlValues, , , xlPrevious).Row
            Dim a_Row As Long
            
            iColStart = lo.ListColumns("Start").Index
            iColEnd = lo.ListColumns("End").Index
            a_Row = Columns(1).Find("Start", , xlValues, xlWhole).Row
    
            For eachRow = a_Row To LastRow
                'For y = iColStart To iColEnd
                For y = iColStart To iColEnd - 1
                    resultString = resultString & xWs.Cells(eachRow, y)
                Next y
                    Cells(eachRow, 1) = resultString
                    resultString = Empty
                Next eachRow
        End If
    Next xWs
End Sub
Изменено: Alex D - 03.03.2020 19:27:10
 
Позвольте вернуться к теме.
Задача, таже. Мне очень помогли. Я докрутил макрос. Макрос ходит по листам о объеденяет ячейки. Все класно.
Но. на одном листе выдает ошибку. Пример прикрепил. Что не так?

Исправил.

Код
Sub concat_test()
    Dim xWs As Worksheet
    Dim lo As ListObject
    Dim iColStart As Long
    Dim iColEnd As Long
    
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "sheet_name_1" And xWs.Name <> "sheet_name_2" Then
        xWs.Activate
            
            Set xWs = ActiveSheet
            Set lo = ActiveSheet.ListObjects(1)
            
            Dim resultString As String
            Dim LastRow As Integer
            Dim a_Row As Long
            
            iColStart = lo.ListColumns("start").Index
            iColEnd = lo.ListColumns("end").Index
            
            'LastRow = Range(lo).Find("*", , xlValues, , , xlPrevious).Row  'Error messenger 1004
            LastRow = lo.Range.Find("*", , xlValues, , , xlPrevious).Row 'Range(lo) -> lo.Range


            a_Row = Columns(1).Find("start", , xlValues, xlWhole).Row
            
            For eachRow = a_Row + 1 To LastRow
                'For y = iColStart To iColEnd
                For y = iColStart To iColEnd - 1
                    resultString = resultString & xWs.Cells(eachRow, y)
                Next y
                    Cells(eachRow, 1) = resultString
                    resultString = Empty
                Next eachRow
        End If
    Next xWs
End Sub
Изменено: Alex D - 04.03.2020 18:36:33
Страницы: 1
Наверх