Сделать числовой формат макросом

Автор runner, 10.08.2016, 11:44

« назад - далее »

runner

Проблема кажется пустяковой, но не решается.

Исходная таблица - из 1С (искренне не люблю и не понимаю их дубовый формат, может, отсюда и проблемы)
В столбце с ценой, в результате, получаются вперемешку ячейки и текстового и числового формата. Числовой формат только у нулей, которые изначально были пустым местом.
F2 по каждой ячейке, конечно же приводит её в правильный вид, но надо чтобы он получался сразу!

Selection.NumberFormat = "#,##0.00" - не помогает
умножение на 1 - не помогает (вне макроса помогает отлично)
замена запятых на запятые же - не помогает (вне макроса помогает отлично)

Подскажите команду, плизз :)

vikttur

Если скажете, как в Вашем рисунке найти Ваш макрос, который нужно подправить, то, может быть, кто-то поможет :)

runner

Делаю сборкой из маленьких кусков - по-другому пока не умею :)

Sub Price_SSprj()
'
' Price_SSprj Макрос
' Прайс из отчёта состояние склада
'

'
    Workbooks.Add
    Columns("C:C").Select
    Selection.NumberFormat = "@"
    Range("A1").Select
    ActiveSheet.PasteSpecial Format:="Текст", Link:=False, DisplayAsIcon:= _
        False
    Range("A3").Select
    Selection.Copy
    Range("E3").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False 'Замена симв160+2строки выше
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
        Range("G3").Select
    ActiveCell.FormulaR1C1 = "=if(RC[-2]=0,"""",if(RC[-2]>99,""100>"",if(RC[-2]>49,""50>"",if(RC[-2]>19,""20>"",if(RC[-2]>9,""10>"",RC[-2])))))"
    Range("G3").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("G3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("H:H").Select
    Selection.NumberFormat = "General"
    Range("H3").Select
    ActiveCell.FormulaR1C1 = "=if(RC[-2]=0,"""",if(RC[-2]>99,""100>"",if(RC[-2]>49,""50>"",if(RC[-2]>19,""20>"",if(RC[-2]>9,""10>"",RC[-2])))))"
    Range("H3").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("H3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G3:H3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A1:R2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    Cells.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    Columns("A:C").EntireColumn.AutoFit
    Columns("D:D").Select
    Selection.ColumnWidth = 100
    Range("E1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Columns("E:F").Select
    Range("E2").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Columns("G:P").Select
    Selection.Delete Shift:=xlToLeft
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Цена $"
    Range("G2").Select
    Selection.ClearContents
    Range("G1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("G:G").Select
    Selection.NumberFormat = "#,##0.00"
    Range("G3").Select
    Range(Selection, Selection.End(xlDown)).Select 'перезамена запятых 4 строки
    Selection.Replace What:=",", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=""SenSen_Наличие_""&TEXT(NOW(),""ГГГГ-ММ-ДД"")"
    Range("D2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Application.ReplaceFormat.Clear 'очистка формата замены
    Dim WbFname$, TFname$, Twb As Workbook
    WbFname = ActiveWorkbook.FullName 'Запоминаем путь к активной книге
    Application.DisplayAlerts = False 'убирает предупреждение о замене и совместимости
    TFname = "C:\Users\zheltov\Documents\SENSEN\Прайс\" & Range("D2").Value 'Формируем имя файла
    'Сохраняем книгу при этом активная книга закрывается и открывается сохраненная
    ActiveWorkbook.SaveAs Filename:=TFname, FileFormat:=xlExcel8, CreateBackup:=False
    Set Twb = ActiveWorkbook 'Запоминаем активную книгу в переменную
    ActiveWorkbook.Close False 'Закрываем книгу из переменной
    Range("A1").Select
    End With
End Sub

vikttur

Без намеков, прямым текстом:
почему сразу не показать файл-пример с Вашим макроссом? Помогающим нужно создать файл, придумать данные, вставить Ваш макрос?
Кому оно надо? Вы сами должны стараться максимально приблизить решение, а не другие. Неужели это так трудно понять? И на форуме не первый день...

runner

Не хотел вызвать раздражение - проблема видится на этапе переноса данных из 1С в Excel.
Идея процесса: формируется отчёт в 1С, таблица копируется в буфер (просто Ctrl+C), далее, запускается макрос, который форматирует его в нужный вид и сохраняет в указанное место.

Приложил пример, вроде адекватен по результату.

vikttur

#5
Ну, как Вам помогать?
К первому сообщению приложена картинка со столбцом, в котором числовые данные с запятой. В коде, показанном в другом сообщении:
    Columns("G:G").Select
    Selection.NumberFormat = "#,##0.00"

В третьем сообщении в файле (без макроса!) в столбце G количество продаж - числа без разделителей... В столбцах L и Q данные числовые, преобразовывать не нужно.
Где проблема?

Вы как будто сами специально затягиваете помощь.
Нужно показать пример данных, описать задачу обычными словами (в этом столбце - вот это, его нужно сделать вот так. Все!), на всякий случай в файле разместить свой код.

runner

Я не стараюсь затягивать, извините.

Начнём сначала.
Макрос не в файле с данными, а в personal.xlsb
Исходные данные для его работы не файл, а таблица отчёта 1С скопированная в буфер обмена.
Идея в том, чтобы после этого надо было только нажать кнопку макроса и получить желаемое.
На картинке в первом сообщении - результат и проблема отображения.
Файл,с данными, который прислал в третьем сообщении - исходные данные из 1С сохранённые как *.xls
Они так не используются, но надо же что-то показать. Используемые в таком виде приводят к тому же проблемному результату.

Адекватный происходящему результат получается если скопировать таблицу(только) в файле FB.xls, закрыть таблицу, сохранив данные в буфере для последующей вставки (без закрытия файла у меня потом макрос ругается, по непонятной причине). Запустить макрос и посмотреть результат.
Единственно, может, путь сохранения упростить до стандартного положения:
TFname = "C:\Users\zheltov\Documents\" & Range("D2").Value


Я уверен, что мягко говоря, не первый столкнулся с таким отображением данных с исходными данными из 1С, и понадеялся, что есть какой-то способ/команда - либо обнуление всех форматов, либо жёсткая установка формата, стирающая все следы предыдущих.

в команде:
Selection.NumberFormat = "#,##0.00"   замена точки на запятую приводит к совсем уже неправильному отображению чисел.

vikttur

Вставить как значения в столбцы с текстовым форматом и преобразовать на месте.

runner

 Вопрос решился нелогичной заменой запятых на точки(в макросе), видимо, Excel только после этого сумел встроить числовой формат.
С запятыми, что удивляет.


vikttur

В VBA разделитель - точка, ничего удивительного

runner

Ничего удивительного - когда знаешь :)
  Теперь и я не забуду :)

Спасибо!