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

micch

做到吐了

图表做多了动力就小了

493861364

micch 发表于 2022-7-11 20:47
做到吐了

图表做多了动力就小了

你咋知道的，我就想说这句话的，本来想搞个这种类型图表的通用工具来着，其实就是360个点都赋值为0，然后把个别特殊位置的数据点重新赋值，想要做几个扇叶就搞几个数据系列
搞一半做不动了，过些日子捡起来再继续吧

打算换个类型的图表做做了，或者换PPT折腾折腾了

493861364

micch 发表于 2022-7-11 19:32
大致糊弄了一个录屏，文件大就不压缩了，分卷要分几十个，发到网站上看吧。

自己做能明白，如何表 ...

9号粉丝是我，老师这个是用什么软件录制的啊

micch

493861364 发表于 2022-7-11 21:39
9号粉丝是我，老师这个是用什么软件录制的啊

FSCapture，忘了啥时候装的了。平常都是用licecap录屏，不过那个录屏只是gif图片。

493861364

micch 发表于 2022-7-11 19:32
大致糊弄了一个录屏，文件大就不压缩了，分卷要分几十个，发到网站上看吧。

自己做能明白，如何表 ...

我看了，讲的挺明白的，其实论坛要是能开放一个视频平台就好了，专攻office相关的，毕竟这都自媒体时代了
加油！

02761752696

micch 发表于 2022-7-11 19:32
大致糊弄了一个录屏，文件大就不压缩了，分卷要分几十个，发到网站上看吧。

自己做能明白，如何表 ...

哇，橘子老师的声音好有磁性啊
教程超赞，老师布置图表数据好厉害，教程应该是代码计算的数据吧
求分享求分享，研究下谢谢

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
散点蚊香

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