VBA多数组交叉合并输出至单行的技术求助

问题根源 #

当前代码的最后写入逻辑是将三个数组按整体顺序拼接（先输出QARRAY全部元素，再输出DARRAY，最后输出PARRAY），与你需要的按索引交叉取元素的需求不符。要实现A,1,q,B,2,w,...的单行输出，需先构建交叉合并后的新数组，再一次性写入目标单元格。

修正后的写入逻辑 #

替换原代码中LOGS ARRAY INTO QLOGS部分的代码为以下内容：

''''''''''''''''''''''''
'LOGS ARRAY INTO QLOGS
'''''''''''''''''''''''

Dim wsDest As Worksheet
Dim Rbase As Range
Dim DestLR As Long
Dim i As Integer
Dim mergedArr() As Variant ' 交叉合并后的数组
Dim arrCount As Integer

' 获取数组元素数量（假设三个数组长度一致）
arrCount = UBound(DARRAY) - LBound(DARRAY) + 1
' 定义合并数组大小：每个原数组元素占3个位置，总长度为 arrCount * 3
ReDim mergedArr(1 To arrCount * 3)

' 交叉填充合并数组
For i = LBound(DARRAY) To UBound(DARRAY)
    Dim currentPos As Integer
    currentPos = i * 3 + 1 ' 计算当前元素在合并数组中的起始位置
    mergedArr(currentPos) = DARRAY(i)    ' 对应需求中的Arr1元素
    mergedArr(currentPos + 1) = PARRAY(i) ' 对应需求中的Arr2元素
    mergedArr(currentPos + 2) = QARRAY(i) ' 对应需求中的Arr3元素
Next i

Set wsDest = Workbooks("TrackerACG.xlsm").Sheets("QLogs")
DestLR = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
Set Rbase = wsDest.Range("N" & DestLR)

' 将合并数组一次性写入单行单元格
Rbase.Resize(1, UBound(mergedArr)).Value = mergedArr

额外优化建议 #

• 移除Activate操作：原代码中Pws.Activate这类操作会降低效率且易引发错误，建议直接通过工作表对象引用单元格，例如Pws.Cells.Find(...)替代Cells.Find(...)。
• 预定义数组大小：先统计可见工作表数量，一次性定义数组大小，避免多次ReDim Preserve（频繁调整数组大小会影响性能）。
• 添加错误处理：为Find方法添加错误捕获，防止找不到目标文本时代码崩溃，例如：

  Dim findResult As Range
  Set findResult = Pws.Cells.Find(...)
  If Not findResult Is Nothing Then
      ' 执行赋值操作
  End If
  

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