VBA复制含空白列的单元格区域到剪贴板时遇下标越界错误求助

错误原因 #

1. 下标越界：循环结束后，i的值为rangeData.Rows.Count + 1，j的值为rangeData.Columns.Count + 6，此时用dataArr(i, j - 1)访问数组，完全超出了数组的有效下标范围。
2. Join函数使用错误：Join要求传入一维数组，但你直接传入了二维数组的单个元素，不符合函数参数要求。

修正后的代码 #

Dim rangeData As Range
Dim dataArr() As Variant
Dim i As Long
Dim j As Long
Dim clipboardText As String
Dim rowArr() As Variant

Set rangeData = targetSheet.Range("B2:G25")
' 初始化目标数组，原区域6列，新增5空白列，共11列
ReDim dataArr(1 To rangeData.Rows.Count, 1 To rangeData.Columns.Count + 5)

' 填充数组（原逻辑保留，这里没问题）
For i = 1 To rangeData.Rows.Count
    For j = 1 To rangeData.Columns.Count + 5
        If j < 2 Then
            dataArr(i, j) = rangeData.Cells(i, j)
        ElseIf j = 2 Or j = 6 Or j = 7 Or j = 8 Or j = 9 Then
            dataArr(i, j) = ""
        ElseIf j = 3 Or j = 4 Or j = 5 Then
            dataArr(i, j) = rangeData.Cells(i, j - 1)
        ElseIf j = 10 Or j = 11 Then
            dataArr(i, j) = rangeData.Cells(i, j - 5)
        End If
    Next j
Next i

' 处理剪贴板文本：将二维数组每行转为一维数组，再拼接成CSV格式字符串
ReDim rowArr(1 To UBound(dataArr, 2))
For i = 1 To UBound(dataArr, 1)
    ' 将当前行的二维数组元素复制到一维数组
    For j = 1 To UBound(dataArr, 2)
        rowArr(j) = dataArr(i, j)
    Next j
    ' 拼接每行，用逗号分隔列，换行分隔行
    clipboardText = clipboardText & Join(rowArr, ",") & vbCrLf
Next i

' 移除最后一行多余的换行符
If Len(clipboardText) > 0 Then
    clipboardText = Left(clipboardText, Len(clipboardText) - 2)
End If

' 写入剪贴板
Dim objData As New MSForms.DataObject
objData.SetText clipboardText
objData.PutInClipboard

关键修改说明 #

• 新增rowArr一维数组，用于临时存储每行的元素，满足Join函数的参数要求；
• 遍历数组的每一行，拼接成完整的文本内容，每行用换行符分隔；
• 移除循环结束后越界的i、j变量，改用数组的上下界（UBound）来遍历，避免下标错误。

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