VBA直接设置JSON数组（无需迭代）及Google Sheets数据同步优化

一、VBA中直接解析JSON数组并批量写入 #

借助VBA-JSON库实现JSON解析，将解析后的结果直接转为二维数组，再批量写入工作表（无需逐行迭代）：

1. 先将VBA-JSON模块导入你的VBA项目（可从开源仓库获取模块代码，插入到VBA编辑器中）
2. 使用以下代码完成请求、解析与批量写入：

Sub BatchWriteJSONData()
    Dim http As Object, json As Object
    Dim dataArr As Variant
    Dim targetSheet As Worksheet
    
    ' 发送请求获取WebApp返回的JSON数据
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://script.google.com/macros/s/你的WebApp部署ID/exec", False
    http.Send
    
    ' 解析JSON为二维数组
    Set json = JsonConverter.ParseJson(http.ResponseText)
    dataArr = json ' 确保WebApp返回的是二维数组结构
    
    ' 批量写入目标工作表
    Set targetSheet = ThisWorkbook.Sheets("目标工作表名")
    targetSheet.Range("A1").Resize(UBound(dataArr, 1), UBound(dataArr, 2)).Value = dataArr
End Sub

二、修改Google Apps Script按日期条件返回数据 #

实现逻辑：接收客户端传入的基准日期，检查工作表第一列的日期——若存在不匹配的日期则返回全部数据（供客户端覆盖），若所有日期均匹配则返回空数组（供客户端保留现有数据）：

function doGet(e) {
  const ss = SpreadsheetApp.openById("你的Google表格ID");
  const sheet = ss.getSheetByName("目标工作表名");
  const allData = sheet.getDataRange().getValues();
  const requestDate = new Date(e.parameter.date); // 从请求参数获取基准日期
  
  ' 遍历检查第一列日期是否全部匹配（忽略时间部分）
  let allMatch = true;
  for (let i = 1; i < allData.length; i++) { // 跳过表头行
    const sheetDate = new Date(allData[i][0]);
    if (sheetDate.toDateString() !== requestDate.toDateString()) {
      allMatch = false;
      break;
    }
  }
  
  ' 返回对应结果
  const output = allMatch ? [] : allData;
  return ContentService.createTextOutput(JSON.stringify(output))
    .setMimeType(ContentService.MimeType.JSON);
}

客户端请求时需携带日期参数，示例：https://script.google.com/macros/s/你的WebApp部署ID/exec?date=2024-05-20

三、VBA替换逐行写为数组批量操作 #

将数据先存入二维数组，再一次性写入工作表，替代逐行循环的低效写法：

原逐行写入（低效） #

' 假设jsonItems是解析后的JSON对象集合
Dim i As Integer
For i = 1 To jsonItems.Count
    Sheets("Sheet1").Cells(i, 1).Value = jsonItems(i)("date")
    Sheets("Sheet1").Cells(i, 2).Value = jsonItems(i)("amount")
Next i

修改后数组批量操作（高效） #

Dim dataArr As Variant
Dim i As Integer
' 根据数据列数调整数组维度
ReDim dataArr(1 To jsonItems.Count, 1 To 2)

' 先将数据填充到数组
For i = 1 To jsonItems.Count
    dataArr(i, 1) = jsonItems(i)("date")
    dataArr(i, 2) = jsonItems(i)("amount")
Next i

' 一次性写入工作表
Sheets("Sheet1").Range("A1").Resize(UBound(dataArr, 1), UBound(dataArr, 2)).Value = dataArr

内容的提问来源于stack exchange，提问作者Far