偶尔兴致来了，练习一些图表，记录一下

micch

02761752696 发表于 2022-7-12 08:39
哇，橘子老师的声音好有磁性啊
教程超赞，老师布置图表数据好厉害，教程应该是代码计算的数据吧
...

没有系统的整理，就是用到啥录制宏改改。数据处理的代码，我整理一下

1. Sub Main()
   
2.     Dim xAr, yAr
   
3.     With ActiveSheet
   
4.         n = .Range("C2").Value
   
5.         xAr = GetxValues(50, 80, 40, n)
   
6.         .Range("T2").Resize(, UBound(xAr)).Value = xAr
   
7.         r = 2
   
8.         For c = 4 To 7
   
9.             ar = .Cells(6, c).Resize(n).Value
   
10.             yAr = GetyValues(ar)
    
11.             yAr2 = GetYValues2(yAr)
    
12.             '---输出位置
    
13.             r = r + 2
    
14.             .Range("T" & r).Resize(, UBound(yAr)).Value = yAr
    
15.             .Range("T" & r + 1).Resize(, UBound(yAr2)).Value = yAr2
    
16.         Next
    
17.     End With
    
18. End Sub
    
19. 
    
20. Rem     系列数据展开为4个一组，重复两次空两个
    
21. Rem     ar对应一列数据的值
    
22. Function GetyValues(ar)
    
23.     Dim yAr, u%, i%, j%
    
24.     u = UBound(ar)
    
25.     ReDim yAr(1 To u * 4)
    
26.     For i = 1 To u
    
27.         j = i * 4 - 3
    
28.         yAr(j) = ar(i, 1)
    
29.         yAr(j + 1) = yAr(j)
    
30.     Next
    
31.     GetyValues = yAr
    
32. End Function
    
33. Rem     间隔数据辅助系列
    
34. Function GetYValues2(ar)
    
35.     Dim br, u%, i%, k
    
36.     u = UBound(ar)
    
37.     ReDim br(1 To u)
    
38.     For i = 1 To u - 1
    
39.         k = ar(i)
    
40.         If Len(k) = 0 Then
    
41.             br(i) = ar(i + (-1) ^ (i Mod 2))
    
42.         End If
    
43.     Next
    
44.     GetYValues2 = br
    
45. End Function
    
46. Rem     计算出X轴的坐标数据
    
47. Rem     StartX,W0,W1,N0对应X轴其实刻度，柱形的宽度，间隔连接四边形刻度,数据的数量
    
48. Function GetxValues(StartX, W0, W1, N0)
    
49.     Dim xAr, i%, j%, k
    
50.     ReDim xAr(1 To N0 * 4)
    
51.     '---X轴坐标两两一组
    
52.     xAr(1) = StartX
    
53.     For i = 2 To UBound(xAr) - 1 Step 2
    
54.         j = j Mod 2 + 1
    
55.         If j = 2 Then
    
56.             xAr(i) = xAr(i - 1) + W1
    
57.         Else
    
58.             xAr(i) = xAr(i - 1) + W0
    
59.         End If
    
60.         xAr(i + 1) = xAr(i)
    
61.     Next
    
62.     GetxValues = xAr
    
63. End Function
    

复制代码

图表的代码就不值得整理了，太乱。其实就是录制完改改

micch

散点蚊香

493861364

micch 发表于 2022-7-14 00:46
散点蚊香

这个颜色，没毛病，给一根火柴就能熏蚊子了

micch

micch 发表于 2022-7-14 00:46
散点蚊香

就是半径递增，角度匀速旋转。然后半径和角度换算出平面坐标就行。递增的幅度不同，效果有一些变化，其实整体样式句是个这种样式

a50060

学习学习，

493861364

咱也不晓得这叫个啥，看到就画一个，能动的，楼主大侠不要介意哈，整个图表版块都太冷清了

micch

也不知道怎么回事，我现在发不了gif图，发出来就是个黑屏。再发一次试试






gif图还是无法显示，也懒得找原因了，直接发网上吧

1. https://www.bilibili.com/video/BV1Ut4y157CF?share_source=copy_web&vd_source=dafb773bc780c6bae3be1b5babc77410

复制代码

493861364

micch 发表于 2022-7-22 15:54
也不知道怎么回事，我现在发不了gif图，发出来就是个黑屏。再发一次试试

这个牛，向大侠好好学习！！

02761752696

micch 发表于 2022-7-22 15:54
也不知道怎么回事，我现在发不了gif图，发出来就是个黑屏。再发一次试试

好创意，不知道用什么方法做的，仿了一个

493861364

返璞归真，突出展示最近7天的数据