Excel: Макрос для сборки данных

[Администратор]

Я сейчас взял наобум 10 000 символов и вставляю их в ячейку. Ошибки не возникает. Пробовал и в "Excel 2003" это сделать.
Ошибка при вставке данных из vba-массива может быть, если в массиве есть какие-нибудь специфические знаки, например, в начале ячейки есть знак равно.
Чтобы специальные знаки не мешали работе макроса, нужно сделать на листе-результате формат ячеек "Текстовый".

[iva]

Run-time error "1004":
Application-defined or object defined error

[Администратор]

Сделайте на листе-шаблоне формат ячеек "Текстовый" и снова запустите макрос на том файле, который вызывает ошибку.

[Администратор]

Если проблема исчезнет. То сделайте текстовый формат в тех столбцах, в которых по вашему мнению, могут быть специфические знаки, а в остальных столбцах сделайте нужный формат.

[iva]

Обнаружила, что если надо объединить 27 строк, то ошибки нет. Если больше, ошибка.

[Администратор]

А текстовый формат сделали? Перейдите на лист-шаблон - выделите все ячейки (ну или столбцы целиком, где находятся данные) - вкладка "Главная" - группа "Число" - в списке выберите "Текстовый".
После этого запустите макрос на том файле, который вызывает ошибку. Осталась ошибка?

[iva]

Поменяла на текстовый формат и на исходном листе, и на шаблоне - ошибка так и есть.
Специфических знаков не обнаружила нигде.

Во вложении смоделировала ошибку.



[вложение удалено администратором]

[Администратор]

Какая у вас версия экселя: 2003, 2007 или другая?

[iva]

2003. Сейчас попробовала в 2010. Отработал весь файл. Кажется, все верно.

[Администратор]

Да, у меня та же ошибка в "Excel 2003". Значит для вашей задачи не подходит "Excel 2003".

[Администратор]

В "Excel 2003" максимальное кол-во символов в ячейке должно быть 255 символов.
Если больше, то в самой ячейке текст не видно (видно только в строке формул).
Поэтому если вам нужно видеть, что находится в ячейке, то "Excel 2003" вам не подходит. Если не нужно видеть, то можно попробовать изменить макрос - если вставлять не массив, а из переменной, то ошибки не происходит.

В файле демонстрируется, как видно и как не видно. Чтобы увидеть проблему, файл нужно открывать в "Excel 2003".

[вложение удалено администратором]

[iva]

1) Мне нравится 2003 Excel, и в нем я постоянно работаю. Но раз этот макрос работает в 2010, то это решает проблему. Буду запускать макрос в 2010, а с результатом работать в 2003.
Главное, что он работает и решает очень нужную мне задачу. За что вам большое спасибо!

2) "В "Excel 2003" максимальное кол-во символов в ячейке должно быть 255 символов."

В общем-то мне не надо видеть. Не предполагается, что этот файл будут "читать глазами". А выборочно , если потребуется, можно прочитать через строку формул.
С другой стороны, "видимость" наверное лишней бы не была. Все зависит от того, насколько вам сложно это доработать. Если сложно, я могу без этого спокойно обойтись.

3) Обнаружила, что в данных бывает заполнен столбец А (например группа из 7 значений), столбец В (также 7 значений), а столбец F содержит меньше значений - 3, 4... (т.е. какие-то ячейки пустые).
Соответственно при объединении появляются ";;;;" вместо пустых ячеек. Например, "Стол 1; стол 2; стол 3;;;;;".
Если можно убрать лишние ";", то было бы удобно.

[Администратор]

Эта версия работает в "Excel 2003" (и в других версиях). Также учтёно, если в столбце "F" (на исходном листе) будут пустые ячейки.
В этой версии три процедуры, все их поместите в один модуль и запускайте только процедуру "Макрос".

Макрос

Sub Макрос()

    Dim shSrc As Worksheet, shRes As Worksheet, res()
    Dim lr As Long
   
   
    '1. Отключение монитора, чтобы ускорить работу макроса и чтобы не мерцало.
    Application.ScreenUpdating = False
   
    '2. Присваивание имени листу-источнику.
    Set shSrc = Worksheets("исходный")
   
    '3. Отображение скрытых строк, чтобы найти последнюю строку.
        ' Метод End не ищет в скрытых строках.
    If shSrc.AutoFilterMode = True Then
        shSrc.AutoFilter.ShowAllData
    End If
    shSrc.Rows.Hidden = False
   
    '4. Обработка данных. Обработанные данные запишутся в массив "res".
    Process shSrc, res()
   
    '5. Создание листа-результата. Учитывается, если лист-шаблон будет скрыт.
    ' Копирование перед, а не сразу после, т.к. если есть скрытые листы,
        ' то потом сложно найти вставленный лист - нужно анализировать скрытые листы.
    Worksheets("шаблон").Copy Before:=shSrc
    Set shRes = shSrc.Previous
    shRes.Visible = True
    shRes.Move After:=shSrc
    ' Ошибка будет, если уже есть лист с таким именем.
    On Error Resume Next
        shRes.Name = "Результат"
    On Error GoTo 0
   
    '6. Вставка массива "res" на лист-результат.
    InsertToShRes shRes, res()
   
    '7. Копирование оформления из строки 2 во все остальные строки.
    lr = shRes.UsedRange.Rows.Count
    If lr > 2 Then
        shRes.Rows(2).Copy
        shRes.Rows("2:" & lr).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        shRes.Range("A1").Select
    End If
   
    '8. Вкл. монитора.
    Application.ScreenUpdating = True
   
End Sub

Private Sub Process(shSrc As Worksheet, res())

    ' Обработка данных.
   
    Dim src(), arr()
    Dim lr As Long, i As Long, r As Long
   
   
    '1. В столбце B удаление повторов, в столбце F объединение данных в одну ячейку.
    ' Копирование данных в массив. С массивом быстрее работать, чем с эксель-ячейками.
    lr = shSrc.Cells(shSrc.Rows.Count, "B").End(xlUp).Row
    src() = shSrc.Range("A1:S" & lr).Value
   
    ' В столбце B удаление повторов, в столбце F объединение данных в одну ячейку.
    For i = UBound(src, 1) To 3 Step -1
        If src(i, 2) = src(i - 1, 2) Then
            src(i, 2) = Empty
            If src(i, 6) <> "" Then
                If src(i - 1, 6) = "" Then
                    src(i - 1, 6) = src(i, 6)
                Else
                    src(i - 1, 6) = src(i - 1, 6) & ";" & src(i, 6)
                End If
            End If
        End If
    Next i
   
    '2. Копирование данных из массива "src" в массив "res".
        ' Копируются только те строки, у которых не пусто в столбце B.
    ' Создание ячеек в массиве-результате.
        ' Создаётся максимально возможное кол-во строк, т.к. заранее не известо, сколько будет данных.
    ReDim res(1 To UBound(src, 1), 1 To 6)
    For i = 2 To UBound(src, 1)
        If src(i, 2) <> "" Then
            r = r + 1
            res(r, 1) = src(i, 2)
            res(r, 2) = src(i, 6)
            res(r, 3) = src(i, 7)
            res(r, 4) = src(i, 13)
            res(r, 5) = src(i, 18)
            res(r, 6) = src(i, 19)
        End If
    Next i
   
    '3. Удаление пустых строк с конца массива "res".
    arr() = res()
    ReDim res(1 To r, 1 To 6)
    For i = 1 To UBound(res, 1)
        For j = 1 To 6
            res(i, j) = arr(i, j)
        Next j
    Next i
   
End Sub

Private Sub InsertToShRes(shRes As Worksheet, res())

    ' Вставка массива "res" на лист-результат.
        ' В "Excel 2003" не получается вставить массив, если в ячейке массива много символов.
        ' Много символов в столбце 2.
       
    Dim arr(), i As Long
   
    '1. Копирование данных во вспомогательный массив.
    arr() = res()
    '2. Удаление данных в столбце 2.
    For i = 1 To UBound(arr, 1)
        arr(i, 2) = Empty
    Next i
    '3. Вставка массива в эксель.
    shRes.Range("A2").Resize(UBound(arr, 1), 6).Value = arr()
    '4. Вставка столбца 2 по-элементно.
    For i = 1 To UBound(res, 1)
        shRes.Cells(i + 1, "B").Value = res(i, 2)
    Next i
   
End Sub

[свернуть]

[iva]

Отработало без ошибок.
Спасибо! Вы очень помогли!