Проблема кажется пустяковой, но не решается.
Исходная таблица - из 1С (искренне не люблю и не понимаю их дубовый формат, может, отсюда и проблемы)
В столбце с ценой, в результате, получаются вперемешку ячейки и текстового и числового формата. Числовой формат только у нулей, которые изначально были пустым местом.
F2 по каждой ячейке, конечно же приводит её в правильный вид, но надо чтобы он получался сразу!
Selection.NumberFormat = "#,##0.00" - не помогает
умножение на 1 - не помогает (вне макроса помогает отлично)
замена запятых на запятые же - не помогает (вне макроса помогает отлично)
Подскажите команду, плизз :)
Если скажете, как в Вашем рисунке найти Ваш макрос, который нужно подправить, то, может быть, кто-то поможет :)
Делаю сборкой из маленьких кусков - по-другому пока не умею :)
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
Без намеков, прямым текстом:
почему сразу не показать файл-пример с Вашим макроссом? Помогающим нужно создать файл, придумать данные, вставить Ваш макрос?
Кому оно надо? Вы сами должны стараться максимально приблизить решение, а не другие. Неужели это так трудно понять? И на форуме не первый день...
Не хотел вызвать раздражение - проблема видится на этапе переноса данных из 1С в Excel.
Идея процесса: формируется отчёт в 1С, таблица копируется в буфер (просто Ctrl+C), далее, запускается макрос, который форматирует его в нужный вид и сохраняет в указанное место.
Приложил пример, вроде адекватен по результату.
Ну, как Вам помогать?
К первому сообщению приложена картинка со столбцом, в котором числовые данные с запятой. В коде, показанном в другом сообщении:
Columns("G:G").Select
Selection.NumberFormat = "#,##0.00"
В третьем сообщении в файле (без макроса!) в столбце G количество продаж - числа без разделителей... В столбцах L и Q данные числовые, преобразовывать не нужно.
Где проблема?
Вы как будто сами специально затягиваете помощь.
Нужно показать пример данных, описать задачу обычными словами (в этом столбце - вот это, его нужно сделать вот так. Все!), на всякий случай в файле разместить свой код.
Я не стараюсь затягивать, извините.
Начнём сначала.
Макрос не в файле с данными, а в personal.xlsb
Исходные данные для его работы не файл, а таблица отчёта 1С скопированная в буфер обмена.
Идея в том, чтобы после этого надо было только нажать кнопку макроса и получить желаемое.
На картинке в первом сообщении - результат и проблема отображения.
Файл,с данными, который прислал в третьем сообщении - исходные данные из 1С сохранённые как *.xls
Они так не используются, но надо же что-то показать. Используемые в таком виде приводят к тому же проблемному результату.
Адекватный происходящему результат получается если скопировать таблицу(только) в файле FB.xls, закрыть таблицу, сохранив данные в буфере для последующей вставки (без закрытия файла у меня потом макрос ругается, по непонятной причине). Запустить макрос и посмотреть результат.
Единственно, может, путь сохранения упростить до стандартного положения:
TFname = "C:\Users\zheltov\Documents\" & Range("D2").Value
Я уверен, что мягко говоря, не первый столкнулся с таким отображением данных с исходными данными из 1С, и понадеялся, что есть какой-то способ/команда - либо обнуление всех форматов, либо жёсткая установка формата, стирающая все следы предыдущих.
в команде:
Selection.NumberFormat = "#,##0.00" замена точки на запятую приводит к совсем уже неправильному отображению чисел.
Вставить как значения в столбцы с текстовым форматом и преобразовать на месте.
Вопрос решился нелогичной заменой запятых на точки(в макросе), видимо, Excel только после этого сумел встроить числовой формат.
С запятыми, что удивляет.
В VBA разделитель - точка, ничего удивительного
Ничего удивительного - когда знаешь :)
Теперь и я не забуду :)
Спасибо!