世界杯进行中，用 Access 做一张赛后分析页

原创于 2026-06-25 09:05:41 发布 · 30 阅读

0 ·

本内容遵循CC 4.0 BY-SA版权协议

GEO检测

标签

#android #数据库 #access开发 #vba #图表

Access开发同时被 3 个专栏收录

157 篇文章

订阅专栏

vba

138 篇文章

订阅专栏

Access图表

11 篇文章

订阅专栏

Hi，大家好！

最近世界杯打得热闹，我自己看球有个习惯，喜欢看完一场比赛回头翻技术统计：控球、射门、角球、犯规这一堆数字。

看着看着就在想，这种小数据是不是我也能搞一个。

一场比赛一行
一组技术统计一张表
每分钟的进攻强度再来一张表
进球、黄牌这些事件单独记一下

数据结构都很标准，那我们就可以动手来做了。

一、先来看看需求

参考一些足球资讯页的常见做法，我把页面拆成三块。

1）顶部比分区

就是比赛基本信息：

阿根廷  2 : 1  奥地利

2）进攻心率图

上半区画一支球队的进攻强度，下半区画另一支，按分钟铺开。柱子高的位置就是那一分钟压得最凶的时候，进球、危险进攻这些事件再打上标记。

光看比分看不出节奏，这张图看得出。

3）对称式技术统计图

左边阿根廷，右边奥地利，中间是指标名字。同一行往两边伸，差距一眼可见。

指标	阿根廷	奥地利
控球率	54	46
角球	1	3
射门	12	6
射正	5	1
犯规	13	13

表格里也能看，只是少了点画面感。
在这里插入图片描述

二、我们不用自带图表，这里用 EdgeBrowser 显示 ECharts

Access 自带的图表控件做柱形图、折线图、饼图都还行，可这次想要的图有点特殊：

进攻心率图要做上下镜像
技术统计图要做左右对称
颜色还得分情况：射门优势绿色，犯规越位红色，黄牌黄色

换个思路，让 ECharts 来画图，Access 负责把数据准备好，再用 EdgeBrowser 控件把网页嵌回窗体里。整套东西仍然跑在 Access 里，用户不用跳浏览器。

之前用 EdgeBrowser 预览 PDF 是同一个套路，思路是通的。
在这里插入图片描述

三、准备好数据

写图之前先把表建好，不然写到后面会很乱。

表名	用途
`t_WcMatches`	比赛基本信息、比分
`t_WcMatchStats`	控球、射门、角球这类技术统计
`t_WcAttackPulse`	每分钟进攻强度
`t_WcMatchEvents`	进球、危险进攻、黄牌等事件

比赛表

CREATE TABLE t_WcMatches (
    MatchID LONG CONSTRAINT pk_WcMatches PRIMARY KEY,
    MatchDate DATETIME,
    Competition TEXT(80),
    LeftTeamName TEXT(50),
    RightTeamName TEXT(50),
    LeftGoals INTEGER,
    RightGoals INTEGER
);

为了短，没单独抽 t_Teams 球队主表。等比赛多了再拆，用 TeamID 关联也来得及。

技术统计表

CREATE TABLE t_WcMatchStats (
    ID AUTOINCREMENT CONSTRAINT pk_WcMatchStats PRIMARY KEY,
    MatchID LONG,
    StatName TEXT(30),
    LeftValue DOUBLE,
    RightValue DOUBLE,
    StatMode TEXT(20),
    SortNo INTEGER
);

里面有个 StatMode 字段，是后面给图表上色用的：

StatMode	用在什么指标
`normal`	射门、射正、角球、被封堵
`percent`	控球率
`bad`	越位、犯规这类越多越不好
`card`	黄牌、红牌

有了这个字段，颜色规则写在图表代码里，新增指标的时候不用动 VBA。

进攻心率表

CREATE TABLE t_WcAttackPulse (
    ID AUTOINCREMENT CONSTRAINT pk_WcAttackPulse PRIMARY KEY,
    MatchID LONG,
    MatchMinute INTEGER,
    LeftPulse INTEGER,
    RightPulse INTEGER
);

每分钟一行。手工录入觉得太碎，可以改成 5 分钟一行，结构一样。

比赛事件表

CREATE TABLE t_WcMatchEvents (
    ID AUTOINCREMENT CONSTRAINT pk_WcMatchEvents PRIMARY KEY,
    MatchID LONG,
    MatchMinute INTEGER,
    EventType TEXT(20),
    TeamSide TEXT(10),
    EventText TEXT(100)
);

只有柱子的心率图看起来有点干，把进球点和危险进攻线打上去，比赛过程对应起来就清楚多了。

四、添加一些数据

表建好以后，进三张明细表手工录几行就行，不用专门写一坨 INSERT 脚本去跑。我自己调画面的时候，随手捏了一场阿根廷 2:1 奥地利的虚构比赛，可以照着填一份。

t_WcMatches

MatchID	MatchDate	Competition	LeftTeamName	RightTeamName	LeftGoals	RightGoals
1	2026-06-23	2026 世界杯小组赛	阿根廷	奥地利	2	1

t_WcMatchStats（示例几行，实际多填几行也能跑）

MatchID	StatName	LeftValue	RightValue	StatMode	SortNo
1	控球率	54	46	percent	1
1	角球	1	3	normal	2
1	射门	12	6	normal	3
1	射正	5	1	normal	4
1	犯规	13	13	bad	9
1	黄牌	2	2	card	10

t_WcAttackPulse（按分钟录，0 到 90 哪几行有数据就填几行，没进攻的那分钟可以省略，也可以填 0）

MatchID	MatchMinute	LeftPulse	RightPulse
1	0	8	0
1	1	45	12
1	2	22	0
1	…	…	…
1	89	0	38

t_WcMatchEvents

MatchID	MatchMinute	EventType	TeamSide	EventText
1	1	Goal	L	阿根廷闪击破门
1	36	Goal	L	阿根廷扩大比分
1	74	Danger	R	奥地利定位球机会
1	89	Goal	R	奥地利扳回一球

数字都是我捏的，错开双方节奏就行。后面换真比赛只要把表里的数据改一改，前端那一坨不用动。

五、VBA 把 Access 数据转成 ECharts 需要的形状

ECharts 吃的是 JavaScript 数组，所以中间要做一次转换。

进攻心率表拼出来长这样：

const pulseData = [
  { minute: 0, left: 8, right: 0 },
  { minute: 1, left: 45, right: 12 },
  { minute: 2, left: 22, right: 0 }
];

技术统计表拼出来长这样：

const statsData = [
  { name: '控球率', left: 54, right: 46, mode: 'percent' },
  { name: '角球', left: 1, right: 3, mode: 'normal' },
  { name: '犯规', left: 13, right: 13, mode: 'bad' }
];

模块里对应两个函数：

Private Function BuildPulseJson(ByVal matchId As Long) As String
Private Function BuildStatsJson(ByVal matchId As Long) As String

打开 Recordset、按比赛 ID 过滤、按分钟或排序号读一遍，拼成字符串就完事。

字段少，我没引第三方 JSON 库。等以后字段多了再换 JsonConverter.bas，也不晚。

六、进攻心率图

这张图就是两组 bar，一组朝上一组朝下。

左队用正数：

pulseData.map(x => [x.minute, x.left])

右队用负数：

pulseData.map(x => [x.minute, -x.right])

series: [
  {
    name: teamLeft,
    type: 'bar',
    data: pulseData.map(x => [x.minute, x.left])
  },
  {
    name: teamRight,
    type: 'bar',
    data: pulseData.map(x => [x.minute, -x.right])
  }
]

tooltip 里把右队的负号再取个绝对值显示，不然鼠标移上去看到 -48 会有点怪。

进球和危险进攻用 markPoint、markLine 打上去，从事件表里读：

const goals = eventsData
  .filter(x => x.type === 'Goal')
  .map(x => ({ name: '⚽', coord: [x.minute, x.side === 'L' ? 96 : -96], value: x.text }));

const dangerLines = eventsData
  .filter(x => x.type === 'Danger')
  .map(x => ({ xAxis: x.minute }));

图上有节奏，也有事件参照。

七、对称式技术统计图

思路和上面差不多，方向变成左右。

const names = statsData.map(x => x.name).reverse();
const left = statsData.map(x => -x.left).reverse();
const right = statsData.map(x => x.right).reverse();

左边是负数，label 要取绝对值，不然会显示成 -54：

label: {
  show: true,
  position: 'left',
  formatter: function(p) {
    return Math.abs(p.value);
  }
}

颜色根据 StatMode 决定：

function colorOf(s, side) {
  if (s.mode === 'bad') return '#e93323';
  if (s.mode === 'card') return '#ffc928';
  if (s.left === s.right) return '#9aa4b4';
  return side === 'left'
    ? (s.left > s.right ? '#25b84b' : '#9aa4b4')
    : (s.right > s.left ? '#25b84b' : '#9aa4b4');
}

比在 Access 图表属性面板里一项项点出来快得多。

八、把 HTML 嵌回 Access 窗体

光是生成一个 HTML 拿浏览器打开，差点意思。

新建窗体控件

添加一个EdgeBrowser控件，名称为ctlEdge

添加代码

先添加一下通用模块，具体的代码如下：

Private Const HTML_FILE_NAME As String = "world-cup-match-analysis.html"

Public Sub SetupWorldCupDemo()
    Dim htmlPath As String
    htmlPath = ExportWorldCupChartHtml(1)
    Application.FollowHyperlink htmlPath
End Sub

Public Sub LoadWorldCupChartToEdge(ByVal frm As Form, ByVal edgeControlName As String, Optional ByVal matchId As Long = 1)
    Dim htmlPath As String
    htmlPath = ExportWorldCupChartHtml(matchId)
    frm.Controls(edgeControlName).ControlSource = "=""https://msaccess/" & htmlPath & """"
End Sub

Public Function ExportWorldCupChartHtml(Optional ByVal matchId As Long = 1) As String
    Dim db As DAO.Database
    Dim rsMatch As DAO.Recordset
    Dim html As String
    Dim htmlPath As String
    Dim teamLeft As String
    Dim teamRight As String
    Dim scoreText As String

    Set db = CurrentDb
    Set rsMatch = db.OpenRecordset("SELECT * FROM t_WcMatches WHERE MatchID=" & matchId, dbOpenSnapshot)

    If rsMatch.EOF Then
        Err.Raise vbObjectError + 510, , "没有找到 MatchID=" & matchId & " 的比赛记录。"
    End If

    teamLeft = Nz(rsMatch!LeftTeamName, "左队")
    teamRight = Nz(rsMatch!RightTeamName, "右队")
    scoreText = Nz(rsMatch!LeftGoals, 0) & " : " & Nz(rsMatch!RightGoals, 0)

    s html, "<!doctype html>"
    s html, "<html lang='zh-CN'>"
    s html, "<head>"
    s html, "<meta charset='utf-8'>"
    s html, "<meta name='viewport' content='width=device-width, initial-scale=1'>"
    s html, "<title>世界杯比赛技术统计</title>"
    s html, "<style>"
    s html, "html,body{margin:0;padding:0;background:#fff;color:#17221c;font-family:'Microsoft YaHei','Segoe UI',sans-serif;}"
    s html, "#attackHeartbeat{width:100%;height:300px;}"
    s html, "#technicalStats{width:100%;height:560px;}"
    s html, "</style>"
    s html, "</head>"
    s html, "<body>"
    s html, "<div id='attackHeartbeat'></div>"
    s html, "<div id='technicalStats'></div>"
    s html, "<script src='https://cdn.jsdelivr.net/npm/echarts@5/dist/echarts.min.js'></script>"
    s html, "<script>"
    s html, "const teamLeft=" & JsQuote(teamLeft) & ";"
    s html, "const teamRight=" & JsQuote(teamRight) & ";"
    s html, "const pulseData=" & BuildPulseJson(matchId) & ";"
    s html, "const statsData=" & BuildStatsJson(matchId) & ";"
    s html, "const eventsData=" & BuildEventsJson(matchId) & ";"
    s html, BuildChartScript()
    s html, "</script>"
    s html, "</body>"
    s html, "</html>"

    htmlPath = CurrentProject.path & "\" & HTML_FILE_NAME
    WriteUtf8Text htmlPath, html
    ExportWorldCupChartHtml = htmlPath

    rsMatch.Close
End Function

Private Function BuildPulseJson(ByVal matchId As Long) As String
    Dim rs As DAO.Recordset
    Dim sJson As String
    Dim comma As String

    Set rs = CurrentDb.OpenRecordset("SELECT MatchMinute, LeftPulse, RightPulse FROM t_WcAttackPulse WHERE MatchID=" & matchId & " ORDER BY MatchMinute", dbOpenSnapshot)
    sJson = "["
    Do Until rs.EOF
        sJson = sJson & comma & "{""minute"":" & rs!matchMinute & ",""left"":" & Nz(rs!leftPulse, 0) & ",""right"":" & Nz(rs!rightPulse, 0) & "}"
        comma = ","
        rs.MoveNext
    Loop
    sJson = sJson & "]"
    rs.Close
    BuildPulseJson = sJson
End Function

Private Function BuildStatsJson(ByVal matchId As Long) As String
    Dim rs As DAO.Recordset
    Dim sJson As String
    Dim comma As String

    Set rs = CurrentDb.OpenRecordset("SELECT StatName, LeftValue, RightValue, StatMode FROM t_WcMatchStats WHERE MatchID=" & matchId & " ORDER BY SortNo", dbOpenSnapshot)
    sJson = "["
    Do Until rs.EOF
        sJson = sJson & comma & "{""name"":" & JsQuote(Nz(rs!statName, "")) & ",""left"":" & Nz(rs!leftValue, 0) & ",""right"":" & Nz(rs!rightValue, 0) & ",""mode"":" & JsQuote(Nz(rs!statMode, "normal")) & "}"
        comma = ","
        rs.MoveNext
    Loop
    sJson = sJson & "]"
    rs.Close
    BuildStatsJson = sJson
End Function

Private Function BuildEventsJson(ByVal matchId As Long) As String
    Dim rs As DAO.Recordset
    Dim sJson As String
    Dim comma As String

    Set rs = CurrentDb.OpenRecordset("SELECT MatchMinute, EventType, TeamSide, EventText FROM t_WcMatchEvents WHERE MatchID=" & matchId & " ORDER BY MatchMinute", dbOpenSnapshot)
    sJson = "["
    Do Until rs.EOF
        sJson = sJson & comma & "{""minute"":" & Nz(rs!matchMinute, 0) & ",""type"":" & JsQuote(Nz(rs!eventType, "")) & ",""side"":" & JsQuote(Nz(rs!teamSide, "")) & ",""text"":" & JsQuote(Nz(rs!eventText, "")) & "}"
        comma = ","
        rs.MoveNext
    Loop
    sJson = sJson & "]"
    rs.Close
    BuildEventsJson = sJson
End Function

Private Function BuildChartScript() As String
     Dim js As String
    s js, "const green='#25b84b', gray='#9aa4b4', red='#e93323', yellow='#ffc928';"
    s js, "const heartbeat=echarts.init(document.getElementById('attackHeartbeat'));"
    s js, "const statsChart=echarts.init(document.getElementById('technicalStats'));"
    s js, "const goals=eventsData.filter(x=>x.type==='Goal').map(x=>({name:'?',coord:[x.minute,x.side==='L'?96:-96],value:x.text}));"
    s js, "const dangerLines=eventsData.filter(x=>x.type==='Danger').map(x=>({xAxis:x.minute}));"
    s js, "heartbeat.setOption({"
    s js, "  legend:{show:true,top:6,itemWidth:14,itemHeight:8,textStyle:{fontSize:13,fontWeight:700},data:[teamLeft,teamRight]},"
    s js, "  grid:{left:42,right:24,top:40,bottom:34},"
    s js, "  tooltip:{trigger:'axis',formatter:function(p){let m=p[0].data[0];let l=p.find(x=>x.seriesName===teamLeft).data[1];let r=Math.abs(p.find(x=>x.seriesName===teamRight).data[1]);return m+`'<br/>`+teamLeft+'：'+l+'<br/>'+teamRight+'：'+r;}},"
    s js, "  xAxis:{type:'value',min:0,max:90,interval:15,axisLabel:{formatter:`{value}'`},splitLine:{lineStyle:{type:'dashed',color:'#dce3dc'}}},"
    s js, "  yAxis:{type:'value',min:-100,max:100,axisLabel:{show:false},axisTick:{show:false},axisLine:{show:false},splitLine:{show:false}},"
    s js, "  series:["
    s js, "    {name:teamLeft,type:'bar',data:pulseData.map(x=>[x.minute,x.left]),barWidth:5,itemStyle:{color:green},markPoint:{symbolSize:30,label:{formatter:'{b}',fontSize:18},data:goals},markLine:{symbol:'none',lineStyle:{color:red,width:1.5},label:{formatter:'危险进攻',color:red},data:dangerLines}},"
    s js, "    {name:teamRight,type:'bar',data:pulseData.map(x=>[x.minute,-x.right]),barWidth:5,itemStyle:{color:gray}}"
    s js, "  ]"
    s js, "});"
    s js, "function colorOf(s,side){if(s.mode==='bad')return red;if(s.mode==='card')return yellow;if(s.left===s.right)return gray;return side==='left'?(s.left>s.right?green:gray):(s.right>s.left?green:gray);}"
    s js, "const names=statsData.map(x=>x.name).reverse();const left=statsData.map(x=>-x.left).reverse();const right=statsData.map(x=>x.right).reverse();"
    s js, "const lc=statsData.map(x=>colorOf(x,'left')).reverse();const rc=statsData.map(x=>colorOf(x,'right')).reverse();"
    s js, "statsChart.setOption({grid:{left:76,right:76,top:18,bottom:18,containLabel:true},tooltip:{trigger:'axis'},xAxis:{type:'value',min:-100,max:100,axisLabel:{show:false},axisTick:{show:false},axisLine:{show:false},splitLine:{show:false}},yAxis:{type:'category',data:names,axisTick:{show:false},axisLine:{show:false},axisLabel:{fontSize:18,fontWeight:800,color:'#17221c',margin:22}},series:[{name:teamLeft,type:'bar',data:left,barWidth:21,itemStyle:{color:function(p){return lc[p.dataIndex]}},label:{show:true,position:'left',formatter:function(p){return Math.abs(p.value)},fontSize:18,fontWeight:800}},{name:teamRight,type:'bar',data:right,barWidth:21,itemStyle:{color:function(p){return rc[p.dataIndex]}},label:{show:true,position:'right',fontSize:18,fontWeight:800}}]});"
    s js, "window.addEventListener('resize',function(){heartbeat.resize();statsChart.resize();});"
    BuildChartScript = js
End Function

Private Sub WriteUtf8Text(ByVal filePath As String, ByVal text As String)
    Dim stm As Object
    Set stm = CreateObject("ADODB.Stream")
    With stm
        .Type = 2
        .Charset = "utf-8"
        .Open
        .WriteText text
        .SaveToFile filePath, 2
        .Close
    End With
End Sub

Private Sub s(ByRef code As String, ByVal line As String)
    code = code & line & vbCrLf
End Sub

Private Function JsQuote(ByVal value As String) As String
    Dim s As String
    s = Replace(value, "\", "\\")
    s = Replace(s, "'", "\'")
    s = Replace(s, vbCrLf, "\n")
    s = Replace(s, vbCr, "\n")
    s = Replace(s, vbLf, "\n")
    JsQuote = "'" & s & "'"
End Function

Private Function HtmlEncode(ByVal value As String) As String
    Dim s As String
    s = Replace(value, "&", "&amp;")
    s = Replace(s, "<", "&lt;")
    s = Replace(s, ">", "&gt;")
    s = Replace(s, """", "&quot;")
    HtmlEncode = s
End Function

模块添加好了，在窗体的加载事件添加代码：

Private Sub Form_Load()
 LoadWorldCupChartToEdge Me, "ctlEdge", 1
End Sub

九、小结

整套流程串起来：

Access 表
  ↓
VBA 查询 + 拼 JSON
  ↓
生成 ECharts HTML
  ↓
EdgeBrowser 加载回 Access 窗体

世界杯还在进行中，有空再录两场真实比赛进去对比一下，会比模拟数据有意思得多。

好了，大家快去测试一下吧。