Тема: 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 или у меня в голове)...
Прошу помощи знающих людей!