Код VBA для автоматического создания диаграмм в excel

Question

Я пытаюсь написать код vba в excel для создания автоматических графиков из многих групп данных.

Я пробовал использовать следующий скрипт, но я столкнулся с трудностью итерации столбцов (ось x, y-ayis графика/графика).

Первый параграф кода скопирован из другого тега отсюда и должен указывать связь между номером столбца и именем (то есть номером столбца 33 = AG).

Моих вопросов:

1. Лучше выбрать регион и применить макрос или записать макрос для точного поля интереса
2. Есть кто-нибудь идею, как можно перебирать столбцы/группы?

Пример моего набора данных (здесь представлены только 3 группы, первый столбец - ось y, первая строка - названия легенды, следующие 13 столбцов - оси x) :

dw=0,01 dw=0,1 dw=1 dw=2 dw=3 dw=4 dw=5 dw=6 dw=8 dw=10 dw=20 dw=30 dw=40 
0,0 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 
0,1 0,4011 0,4057 0,4465 0,4827 0,5119 0,5359 0,5561 0,5732 0,6006 0,6215 0,6786 0,7027 0,7146 
0,2 0,5523 0,5553 0,5810 0,6029 0,6199 0,6332 0,6438 0,6522 0,6643 0,6720 0,6796 0,6682 0,6519 
0,3 0,6290 0,6286 0,6245 0,6195 0,6143 0,6089 0,6035 0,5980 0,5870 0,5762 0,5256 0,4818 0,4440 
0,4 0,6726 0,6689 0,6351 0,6038 0,5774 0,5546 0,5347 0,5169 0,4862 0,4605 0,3705 0,3114 0,2672 
0,5 0,6843 0,6778 0,6199 0,5677 0,5248 0,4887 0,4578 0,4310 0,3866 0,3511 0,2403 0,1787 0,1375 
0,6 0,6656 0,6574 0,5840 0,5185 0,4653 0,4211 0,3839 0,3520 0,3002 0,2599 0,1432 0,0862 0,0520 
0,7 0,6135 0,6045 0,5256 0,4556 0,3991 0,3526 0,3137 0,2806 0,2276 0,1871 0,0757 0,0267 0,0014 
0,8 0,5220 0,5137 0,4400 0,3750 0,3227 0,2798 0,2441 0,2139 0,1660 0,1297 0,0333 0,0060 0,0252 
0,9 0,3632 0,3571 0,3033 0,2559 0,2178 0,1867 0,1609 0,1391 0,1046 0,0787 0,0113 0,0145 0,0266 
1,0 0,2435 0,2393 0,2026 0,1703 0,1443 0,1232 0,1056 0,0908 0,0674 0,0499 0,0046 0,0121 0,0198 

    dw=0,01 dw=0,1 dw=1 dw=2 dw=3 dw=4 dw=5 dw=6 dw=8 dw=10 dw=20 dw=30 dw=40 
0,0 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 
0,1 0,3015 0,3059 0,3454 0,3820 0,4126 0,4386 0,4610 0,4804 0,5124 0,5378 0,6116 0,6464 0,6656 
0,2 0,4161 0,4195 0,4497 0,4771 0,4994 0,5178 0,5331 0,5460 0,5661 0,5808 0,6118 0,6140 0,6066 
0,3 0,4742 0,4751 0,4831 0,4896 0,4940 0,4969 0,4986 0,4995 0,4990 0,4967 0,4720 0,4417 0,4122 
0,4 0,5074 0,5058 0,4911 0,4765 0,4635 0,4516 0,4406 0,4304 0,4120 0,3956 0,3314 0,2842 0,2469 
0,5 0,5165 0,5128 0,4792 0,4475 0,4204 0,3969 0,3761 0,3577 0,3262 0,3001 0,2134 0,1616 0,1256 
0,6 0,5026 0,4975 0,4513 0,4083 0,3721 0,3412 0,3144 0,2910 0,2520 0,2207 0,1254 0,0761 0,0457 
0,7 0,4634 0,4577 0,4061 0,3585 0,3188 0,2851 0,2562 0,2312 0,1900 0,1577 0,0645 0,0214 0,0034 
0,8 0,3945 0,3890 0,3400 0,2949 0,2574 0,2258 0,1989 0,1757 0,1378 0,1084 0,0267 0,0084 0,0260 
0,9 0,2746 0,2705 0,2344 0,2012 0,1737 0,1506 0,1309 0,1140 0,0866 0,0654 0,0077 0,0154 0,0266 
1,0 0,1841 0,1814 0,1566 0,1339 0,1151 0,0993 0,0859 0,0744 0,0557 0,0413 0,0025 0,0125 0,0197 

    dw=0,01 dw=0,1 dw=1 dw=2 dw=3 dw=4 dw=5 dw=6 dw=8 dw=10 dw=20 dw=30 dw=40 
0,0 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 0,0000 
0,1 0,0851 0,0873 0,1081 0,1293 0,1487 0,1665 0,1830 0,1983 0,2257 0,2497 0,3356 0,3891 0,4260 
0,2 0,1198 0,1218 0,1414 0,1611 0,1789 0,1950 0,2098 0,2232 0,2468 0,2669 0,3325 0,3664 0,3849 
0,3 0,1375 0,1388 0,1511 0,1633 0,1742 0,1838 0,1924 0,2000 0,2129 0,2233 0,2512 0,2584 0,2566 
0,4 0,1480 0,1485 0,1529 0,1571 0,1606 0,1635 0,1659 0,1678 0,1706 0,1723 0,1701 0,1600 0,1475 
0,5 0,1514 0,1512 0,1486 0,1458 0,1430 0,1403 0,1376 0,1350 0,1298 0,1248 0,1023 0,0834 0,0675 
0,6 0,1480 0,1472 0,1396 0,1317 0,1245 0,1178 0,1116 0,1058 0,0954 0,0862 0,0523 0,0303 0,0148 
0,7 0,1370 0,1359 0,1254 0,1148 0,1052 0,0964 0,0883 0,0809 0,0679 0,0567 0,0186 0,0037 0,0169 
0,8 0,1171 0,1159 0,1050 0,0940 0,0841 0,0751 0,0669 0,0595 0,0464 0,0353 0,0011 0,0195 0,0302 
0,9 0,0817 0,0809 0,0724 0,0640 0,0564 0,0496 0,0434 0,0377 0,0279 0,0196 0,0064 0,0196 0,0268 
1,0 0,0550 0,0543 0,0485 0,0426 0,0374 0,0326 0,0283 0,0244 0,0176 0,0119 0,0056 0,0145 0,0192 

а вот код, как это кажется сейчас:

Sub Makro3() 
' 
' Makro3 Makro 
'The next lines give the column number to iterate for: 
    Dim i&, k&, j& 
    Dim d As Integer 
    Dim m As Integer 
    Dim name As String 
    d = colNum 
    name = "" 
    Do While (d > 0) 
     m = (d - 1) Mod 26 
     name = Chr(65 + m) + name 
     d = Int((d - m)/26) 
    Loop 
    GetColumnName = name 
' The next lines should give the chart commants: 
For i = 1 To 20 
    ActiveSheet.Shapes.AddChart.Select 
    ActiveChart.ChartType = xlXYScatterSmoothNoMarkers 
    ActiveSheet.Shapes("Diagramm ""i"").IncrementLeft 445.9090551181 
    'here the next chart should be designed below the prior chart 
    ActiveSheet.Shapes("Diagramm ""i"").IncrementTop i * 10 
    ActiveChart.ApplyLayout (1) 
    ' iterate through the columns for each group of series 
    For k = 1 To 13 
    ActiveChart.SeriesCollection.NewSeries 
    ' the name of the column i.e. AH69 
    ActiveChart.SeriesCollection(k).Name = "=linear!$AH$68" 
    ' the x-axis changes with increasing column number 
    ActiveChart.SeriesCollection(k).XValues = "=linear!$AH$69:$AH$79" 
    ' the y-axis changes with increasing group set 
    ActiveChart.SeriesCollection(k).Values = "=linear!$AG$69:$AG$79" 
    Next k 
    ' script lines to define the format of the chart, axes, etc... 
    With 
    ...... 
    End With 
    ActiveChart.Axes(xlCategory).AxisTitle.Select 
Next i 
End Sub 

с помощью этого скрипта я ожидал 3 диаграммы, с 13 кривых каждая. Любая помощь приветствуется.

Answer 1

Я думаю, что это может быть намного проще, чем то, как вы это делаете. См. Код ниже, на основе приведенных данных примера.

я сделал следующие предположения:

1. данных начинается в ячейке A1
2. имя листа «Лист1»
3. набор данных в точности, как это предусмотрено (с одной строки пространство между каждым набором

Исходя из этих предположений, вы можете изменить все ссылки и листы/диапазоны ссылок на ваши нужды.

Sub MakeCharts() 

Dim ws As Worksheet 
Set ws = Sheets("Sheet1") 

Dim x As Integer 

For x = 1 To 38 Step 13 

    ws.Shapes.AddChart.Select 

    With ActiveChart 

     .ChartType = xlXYScatterSmoothNoMarkers 

     Dim k As Integer 

     For k = 1 To 13 

      .SeriesCollection.NewSeries 
      .SeriesCollection(k).Name = ws.Cells(x, k + 1) 
      .SeriesCollection(k).XValues = ws.Range(ws.Cells(x + 1, k + 1), ws.Cells(x + 11, k + 1)) 
      .SeriesCollection(k).Values = ws.Range(ws.Cells(x + 1, 1), ws.Cells(x + 11, 1)) 

     Next 

     .ApplyLayout (1) 

     Dim sName As String 
     sName = Replace(.Name, ws.Name & " ", "") 

    End With 

    With ActiveSheet.Shapes(sName) 
     .IncrementLeft 445.9090551181 
     .IncrementTop x * 10 
    End With 

Next 

End Sub