Страницы: 1
RSS
Вывод массива дат в ось X графика через VBA, Выводимые числа не распознаются как даты
 
Добрый день!

Подскажите, пожалуйста, такой вопрос. Есть массив Dates(), содержащий даты, заполняется он так:
Код
Dim Dates(1 To 30) As Date

For z = i To j - 1
    If Range("A" & z) > "01.01.2018" Then
       Dates(t) = CDate(Range("A" & z))

        ......

       t = t + 1
    End If
Next z
Проверял - массив заполняется корректными значениями. В ячейках именно даты, можно изменять их формат.
Затем этот массив выводится на график в качестве значений Х для нескольких кривых:
Код
WsG.Activate
    ActiveSheet.Shapes.AddChart.Select
    With ActiveChart
    .ChartType = xlXYScatterSmooth
    .SeriesCollection.NewSeries
    .SeriesCollection(1).Name = "="""KGF""
    .SeriesCollection(1).XValues = Dates
    .SeriesCollection(1).Values = KGF


В итоге на график выводится такая вот ерунда:
Код
=РЯД("KGF";{"1/1/2019";"1/1/2020";"1/1/2021";"1/1/2022";"1/1/2023";"1/1/2024";"1/1/2025";"1/1/2026";"1/1/2027";"1/1/2028";"1/1/2029";"1/1/2030";"1/1/2031";"1/1/2032";...
Эти значения не поддаются форматированию, эксель не воспринимает их как даты.

Пробовал делать массив string, variant, записать в массив text ячейки - ничего не помогало. Куда копать, подскажите, пожалуйста.
 
так может этим путем и пойти?
массиву Dates сменить тип и натолкать туда дат переведенные в текст нужного Вам формата, а не того, который подставил Excel  
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Все равно не работает и на графике получается коллекция, которую я представил)
 
файл можно посмотреть?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Конечно!
Спасибо за отклик!
 
см.вложение
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Но в вашем файле совсем нет кода и график построен вручную. Вопрос-то был в том, как вывести на график даты, собранные в массив через VBA
 
Ребят, кто-нибудь еще предложит что-нибудь?
 
Взяв за основу решение Ігор Гончаренко сделал макрос:

Код
lastrow = Worksheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row
ReDim Timee(1 To lastrow - 1) As Date, debit(1 To lastrow - 1)
k = 1

For i = 2 To lastrow
    Timee(k) = Range("a" & i)
    debit(k) = Range("b" & i)
    k = k + 1
Next i

ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterSmooth
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = Timee
ActiveChart.SeriesCollection(1).Values = debit

ActiveSheet.ChartObjects(1).Activate
    ActiveChart.PlotArea.Select
    ActiveChart.Axes(xlCategory).Select
    Selection.TickLabels.NumberFormat = """1.1.""##"
    ActiveChart.Axes(xlCategory).MajorUnit = 1.0
Изменено: ProFessor - 16.04.2018 10:03:47
Вся проблема сложных программ, целых томов кодов и состоит в несоблюдении принципа лезвия Оккама: «Не следует множить сущее без необходимости». Вся гениальность в простоте.
 
Код
Sub u()
Dim iShp As Shape, arr()
With Worksheets("Лист2")
    '---удаляем все диаграммы на листе---
    For Each iShp In .Shapes
        If iShp.Type = msoChart Then iShp.Delete
    Next
    '------------------------------------
    arr = .Range("A2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
    With .Shapes.AddChart(xlLineMarkers, 120, 10, 700, 300).Chart
        With .SeriesCollection(1)
            .XValues = Application.Index(arr, , 1)
            .Values = Application.Index(arr, , 2)
        End With
    End With
End With
End Sub
Изменено: Sanja - 16.04.2018 21:23:54
Согласие есть продукт при полном непротивлении сторон
 
ProFessor, спасибо, но при попытке изменить формат чисел оси Х на ДД.ММ.ГГГГ появляется 1900 год.

Sanja,  спасибо, не знал что так можно создавать диаграммы! Но если в столбце А дата в формате ДД.ММ.ГГГГ, то ошибка 1004 после строки
Код
With .SeriesCollection(1)
При различных форматах и в массиве arr и в массиве Timee оказываются даты, в Watches видны одинаковые записи, но вывод на график почему-то отличается. Эксель что-то пытается додумать или он у меня сломанный?
 
Цитата
peat написал: если в столбце А дата в формате ДД.ММ.ГГГГ, то ошибка 1004
Ошибка не воспроизвелась.(см.файл)
Цитата
peat написал: вывод на график почему-то отличается
В макросе от ProFessor,  тип диаграммы - xlXYScatterSmooth, у меня - xlLineMarkers
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал: Ошибка не воспроизвелась
Хотя нет. Если изменить вручную тип построенной диаграммы, а затем вновь запустить макрос ошибка выскакивает. Разбираюсь...  
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
В макросе от  ProFessor ,  тип диаграммы - xlXYScatterSmooth, у меня - xlLineMarkers
Я пытался в Вашем коде, вот так:

Код
Sub u()
Dim iShp As Shape, arr()

lastrow = Worksheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
ReDim Timee(1 To lastrow - 1) As Double, debit(1 To lastrow - 1)
k = 1

For i = 2 To lastrow
    Timee(k) = Range("a" & i).Value
    debit(k) = Range("b" & i)
    k = k + 1
Next i

With Worksheets("Лист2")
    '---удаляем все диаграммы на листе---
    For Each iShp In .Shapes
        If iShp.Type = msoChart Then iShp.Delete
    Next
    '------------------------------------
    arr = .Range("A2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
    With .Shapes.AddChart(xlLineMarkers, 120, 10, 700, 300).Chart
        With .SeriesCollection(1)
            .XValues = Timee ' Application.Index(arr, , 1)  '
            .Values = debit 'Application.Index(arr, , 2)  '
        End With
    End With
End With

End Sub
Цитата
Код
Sanja написал:
Если изменить вручную тип построенной диаграммы
И еще при каких-то других вариантах, не смог точно их установить.
Изменено: peat - 18.04.2018 07:55:49
 
Проверьте
Код
Sub u()
Dim iShp As Shape, arr(), sCol As SeriesCollection
'On Error Resume Next
With Worksheets("Лист2")
    '---удаляем все диаграммы на листе---
    For Each iShp In .Shapes
        If iShp.Type = msoChart Then iShp.Delete
    Next
    '------------------------------------
    arr = .Range("A2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
    With .Shapes.AddChart(xlLineMarkers, 120, 10, 700, 300).Chart
        Set sCol = .SeriesCollection
        If sCol.Count = 0 Then .SeriesCollection.NewSeries
        With sCol(1)
            .XValues = Application.Index(arr, , 1)
            .Values = Application.Index(arr, , 2)
        End With
    End With
End With
End Sub
Согласие есть продукт при полном непротивлении сторон
 
ОФФ. Зачем Вы перебираете ячейки для наполнения двух своих массивов? В коде видно, как можно всю таблицу сразу взять в массив.
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
Проверьте
Работает, спасибо!

С моими массивами тоже все ок, выходит, дело в типе диаграмм было...Немного странно это, но ок)
Страницы: 1
Наверх