1 (изменено: Mik, 2017-07-25 22:10:23)

Тема: VBA: проблема с сохранением значения в ячейку Excel

Всем доброго вечера!
Сначала опишу решаемую задачу. Есть столбец (допустим "А") на листе Excel с форматом ячеек "общий". В каждой ячейке есть формула, которая вычисляет нужное значение. Значение по своей сути получается числовым (например, 123456789).
Нужно выбирать только не повторяющиеся значения и записывать их в другую ячейку через запятую, причем перед первым и после последнего значения запятой быть не должно (обязательное условие!).
Для решения данной задачи есть макрос, который был взят с простор Интернета и немного видоизменен под конкретную задачу.
И всё прекрасно работало до недавнего времени: когда заполненных ячеек в столбце "А" было более тысячи. Но тут возникла задача делать всё тоже самое, только заполненных ячеек около 20...
В общем, происходит следующее: в ячейку записывается не перечень уникальных значений через запятую, а, как я понимаю, "длинное целое" (например, 1,23456789123456E+305), причем формат ячейки "общий" при этом изменяется на "числовой"!
Уже потратил целую неделю на поиск решения в Интернете, но похоже, что такая проблема только у меня, либо с ней никто не сталкивался... Проверял на Excel 2007 и 2010 - результат одинаковый.
Опытным путем выявил следующее:
- если значений много (примерно, около 1000) всё работает нормально.
- если значение состоит из 9 цифр (99,9% случаев), то корректная работа начинается при заполнении 35 и более строк.
- если значение состоит из 2-х цифр, всё работает корректно, но если значение состоит из 3 и более цифр, то начинается проблема.
- если последнюю запятую не отсекать или заменить ее например, на "/", то тоже всё работает корректно (но сделать этого не могу, т.к. перечень значений потом используется для другого отбора в другом ПО, которое воспринимает только запятую в качестве разделителя значений - можно, конечно, "руками" удалять последнюю запятую, но хочется всё же не выполнять лишних действий).
Код макроса (если нужно, могу приложить файл Excel):

Sub Extract()
    Set rVals = Range("A1:A1048576")
    Set rVals = Intersect(rVals, rVals.Parent.UsedRange)
    avVals = rVals.Value
    Set rResultCell = Range("G2")
    ReDim avArr(1 To Rows.Count, 1 To 1)
    With New Collection
        On Error Resume Next
        For Each x In avVals
            If Len(CStr(x)) Then
                .Add x, CStr(x)
                If Err = 0 Then
                    li = li + 1
                    avArr(li, 1) = x
                    rLine = rLine & x & ","
                Else
                    Err.Clear
                End If
            End If
        Next
    End With
    rLine = Left(rLine, Len(rLine) - Len(","))
    If li Then rResultCell.Value = CStr(rLine)
End Sub

Уже всю голову себе сломал - не пойму в чем проблема (в Excel или у меня в голове)...
Прошу помощи знающих людей!

2

Re: VBA: проблема с сохранением значения в ячейку Excel

Mik
Попробуй указать текстовый формат ячейки для вывода.

3

Re: VBA: проблема с сохранением значения в ячейку Excel

Или есть =СцепитьМного(A2:A100;", ";ИСТИНА)

автор Дмитрий Щербаков

Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : СцепитьМного
'             http://www.excel-vba.ru
' Purpose   : Функция сцепляет все указанные ячейки в одну с указанным разделителем.
' Аргументы функции:
' Диапазон    — диапазон ячеек, значения которых необходимо объединить в строку.
' Разделитель — необязательный аргумент.
'               Один или несколько символов, которые будут вставлены между каждым словом.
'               По умолчанию пробел.
' БезПовторов — необязательный аргумент.
'               Если указан как ИСТИНА или 1 — в результирующей строке будут значения без дубликатов.
'               Для английской локализации данный параметр указывается как TRUE и FALSE соответственно.
'---------------------------------------------------------------------------------------
Function СцепитьМного(Диапазон As Range, Optional Разделитель As String = " ", Optional БезПовторов As Boolean = False)
    Dim avData, lr As Long, lc As Long, sRes As String
    avData = Диапазон.Value
    If Not IsArray(avData) Then
        СцепитьМного = avData
        Exit Function
    End If
 
    For lc = 1 To UBound(avData, 2)
        For lr = 1 To UBound(avData, 1)
            If Len(avData(lr, lc)) Then
                sRes = sRes & Разделитель & avData(lr, lc)
            End If
        Next lr
    Next lc
    If Len(sRes) Then
        sRes = Mid(sRes, Len(Разделитель) + 1)
    End If
    
    If БезПовторов Then
        Dim oDict As Object, sTmpStr
        Set oDict = CreateObject("Scripting.Dictionary")
        sTmpStr = Split(sRes, Разделитель)
        On Error Resume Next
        For lr = LBound(sTmpStr) To UBound(sTmpStr)
            oDict.Add sTmpStr(lr), sTmpStr(lr)
        Next lr
        sRes = ""
        sTmpStr = oDict.keys
        For lr = LBound(sTmpStr) To UBound(sTmpStr)
            sRes = sRes & IIf(sRes <> "", Разделитель, "") & sTmpStr(lr)
        Next lr
    End If
    СцепитьМного = sRes
End Function

4 (изменено: red2881, 2017-07-26 12:04:24)

Re: VBA: проблема с сохранением значения в ячейку Excel

Или костыли.

Sub Extract()
    Set rVals = Range("A1:A1048576")
    Set rVals = Intersect(rVals, rVals.Parent.UsedRange)
    avVals = rVals.Value
    Excel.Range("G2").NumberFormat = "@"
    Set rResultCell = Range("G2")
    ReDim avArr(1 To Rows.Count, 1 To 1)
    With New Collection
        On Error Resume Next
        For Each x In avVals
            If Len(CStr(x)) Then
                .Add x, CStr(x)
                If Err = 0 Then
                    li = li + 1
                    avArr(li, 1) = x
                    rLine = rLine & x & ","
                   
                Else
                    Err.Clear
                End If
            End If
        Next
    End With
    rLine = Left(rLine, Len(rLine) - Len(","))
    If li Then rResultCell.Value = CStr(rLine)
    Excel.Range("G2").NumberFormat = "General"
End Sub

Для справки.
Общее количество знаков в ячейке не может превышать 32 767 знаков.

+ Mik

5

Re: VBA: проблема с сохранением значения в ячейку Excel

red2881
Огромное спасибо!
Действительно, всё решается указанием текстового формата (через интерфейс Excel или код VBA).
Кстати, нашел еще один способ - добавление апострофа в начале (быть может кому-нибудь пригодится):

rResultCell.Value = "'" & CStr(rLine)

Тогда в ячейке информация тоже будет отображаться в текстовом виде причем без апострофа! Но он будет маячить в строке формул...

Общее количество знаков в ячейке не может превышать 32 767 знаков.

Как-нибудь можно обойти данное ограничение?

6

Re: VBA: проблема с сохранением значения в ячейку Excel

Mik В Excel'e нет.