Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Вставка макросом 10ти значного числа без экспоненты.
 
Доброго времени суток.

В повседневном рабочем процессе требуется формировать уникальный список номеров, с последующей вставкой их через запятую в ячейку. Под это дело я приспособил макрос, которым все и произвожу. Все работает, все хорошо, единственная проблема - номера в ячейку вставляются в экспоненте вида 9,06E+11, что меня не устраивает, хотелось бы получить номер полностью. Игры с форматированием ячейки в текст и подстановка ' перед номером результата не дали. Форумы почитал, ответа не нашел, свои идеи кончились.

Если кто подскажет как это сделать - буду благодарен.

Пример макроса и выборки во вложении, заранее извиняюсь за ОЧЕНЬ кривой код, познаю VBA самостоятельно и только делаю первые шаги. Сделать для меня что-то рабочее - уже победа, о элегантности исполнения пока остается только мечтать -_-
 
Увеличил ширину столбца АО и проблема ушла) Или попробуйте вместо rCell.Text использовать rCell.Value
 
вот на этом месте у вас экспоненты и возникают:
Код
[AO12].Resize(.Count, 1) = Application.Transpose(Array(.Keys))

можно выгружать в ячейку сразу .keys при помощи функции Join:
Код
Sub WhiteUnicorn()

Dim x
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
'проверяем что диапазон копируемых значений не пуст. Если пуст - заканчиваем работу.
    If WorksheetFunction.CountA(Range("K12:K1000")) <> 0 Then
'перебираем значения в диапазоне с номерами, формируем уникальный список значений .keys
With CreateObject("Scripting.Dictionary")
    For Each x In Range("K12:K17")
        If Trim(x.Value) <> "" Then .Item(Trim(x.Value)) = 1
    Next
    Cells(3, 6) = Join(.keys, ", ") ' выгружаем список номеров непустых ячеек, через запятую
End With
Else
    Cells(3, 6).ClearContents
    Cells(1, 2).Select
    MsgBox "Выбор пуст!"
End If
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
F1 творит чудеса
 
Код
Sub Unicorn()
Dim x, v
Dim iLastRow As Variant
    Z = WorksheetFunction.CountA(Range("K12:K1000"))
    If Z = 0 Then GoTo errorhandler
With CreateObject("Scripting.Dictionary")
    For Each x In Range("K12:K17")
        For Each v In Split(x, ",")
            v = Trim(v)
            If .Exists(v) Then .Item(v) = .Item(v) + 1 Else .Add v, 1
        Next
    Next
    If .Count Then
        Range("F3") = Join(.keys, ", ")
    Else
        MsgBox "Выбор пуст!"
    End If
End With
errorhandler:
End Sub
 
Спасибо огромное, все работает в лучшем виде. Про .join тоже спасибо, это намного удобнее моей городьбы в макросе, я буду теперь использовать.
 
А мой вариант (без переделки макроса) не пробовали? )
 
Цитата
Юрий М написал: А мой вариант (без переделки макроса) не пробовали? )
Попробовал сразу же). Тоже великолепно работает, вот уж не думал что проблему можно решить таким тривиальным способом).
Страницы: 1
Читают тему (гостей: 1)