VB.Net导出大量数据至Excel失败，报Range类PasteSpecial方法错误

导出400-500条数据到Excel可正常完成，但导出1000-2000条及以上数据时失败，报错信息为PasteSpecial method of Range class failed。相关VB代码如下：

Private Sub ProcessVisibleColumns()

    With Me._ExcelWrks

            .Range("A1").Activate()


            For Each c As Colonna In _Colonne
                _ExcelApp.ActiveCell.Value = c.Label & ""
                _ExcelApp.ActiveCell.Offset(RowOffset:=0, ColumnOffset:=1).Activate()
            Next

        .Range("A1").Select()



        _ExcelApp.Selection.NumberFormat = "@"

            Dim sb As New System.Text.StringBuilder(25000)
            Dim strFormat As New System.Text.StringBuilder(200)
            For i As Integer = 0 To _Colonne.Count - 1
                strFormat.Append("{")
                strFormat.Append(i.ToString)
                strFormat.Append("}")
                strFormat.Append(ControlChars.Tab)
            Next
            strFormat.Remove(strFormat.Length - 1, 1)
            Dim strF As String = strFormat.ToString

            Dim k As Integer = 1
            Dim j As Integer = 0
            Dim CurRow As Integer = 2

            Dim ColValues As ArrayList = New ArrayList(_Colonne.Count)

            For Each r As DataRowView In _Rv
                ColValues.Clear()
                For Each c In _Colonne
                    ColValues.Add(r(c.DataField))
                Next
                sb.AppendFormat(strF, CType(ColValues.ToArray(GetType(Object)), Object()))

            sb.Append(vbNewLine)
            If k = 100 OrElse j = _Rv.Count - 1 Then
                    System.Windows.Forms.Clipboard.SetDataObject(sb.ToString, True)
                    Me._ExcelWrks.Range("A" & CurRow).Select()
                _ExcelApp.ActiveSheet.PasteSpecial()
                CurRow += k
                    k = 0
                    sb.Remove(0, sb.Length)
                End If
                j += 1 : k += 1
                If j = 65536 Then
                    j = 0
                    Me._ExcelWrks.Range("A1").Activate()

                    _ExcelWrks = _ExcelWrkb.Sheets.Add(After:=_ExcelWrks)
                    _ExcelWrks.Activate()

                    Me._ExcelWrks.Range("A1").Activate()
                    For Each c As DataColumn In _Rv.Table.Columns
                        _ExcelApp.ActiveCell.Value = c.ColumnName & ""
                        _ExcelApp.ActiveCell.Offset(RowOffset:=0, ColumnOffset:=1).Activate()
                    Next

                    CurRow = 2
               
                    Me._ExcelWrks.Range("A:A;N:N;AC:AC;AE:AE").Select()
                    _ExcelApp.Selection.NumberFormat = "@"

                End If
            Next


            Me._ExcelWrks.Range("A1").Activate()
            _ExcelApp.Visible = True
        End With

End Sub

问题原因 #

1. 剪贴板容量限制：当拼接的文本内容过大时，剪贴板无法承载，导致SetDataObject写入失败，后续PasteSpecial无数据可粘贴
2. 低效的Excel操作：频繁使用Activate()、Select()操作Excel对象，这类操作依赖Excel的UI状态，容易因状态不稳定触发错误
3. 批次数据量过高：每批次100条数据拼接的字符串长度超出剪贴板承载上限

优化方案 #

方案1：直接批量写入Excel（推荐） #

跳过剪贴板环节，将数据存入二维数组后批量写入Excel，这是最稳定高效的方式，完全避免剪贴板相关问题：

Private Sub ProcessVisibleColumns()
    With Me._ExcelWrks
        ' 写入表头
        For colIndex As Integer = 0 To _Colonne.Count - 1
            .Cells(1, colIndex + 1).Value = _Colonne(colIndex).Label
        Next
        ' 设置表头文本格式
        .Range("A1").Resize(1, _Colonne.Count).NumberFormat = "@"

        Dim totalRows As Integer = _Rv.Count
        Dim currentRow As Integer = 2
        ' 创建二维数组存储所有数据
        Dim dataArray(totalRows - 1, _Colonne.Count - 1) As Object

        ' 填充数据数组
        For rowIndex As Integer = 0 To totalRows - 1
            Dim rowView As DataRowView = _Rv(rowIndex)
            For colIndex As Integer = 0 To _Colonne.Count - 1
                dataArray(rowIndex, colIndex) = rowView(_Colonne(colIndex).DataField)
            Next
        Next

        ' 批量写入数据到Excel
        .Cells(currentRow, 1).Resize(totalRows, _Colonne.Count).Value = dataArray

        ' 处理超过旧版Excel行限制（65536行）的情况
        If totalRows >= 65535 Then ' 表头占1行，数据行最多65535
            Dim sheetCount As Integer = Math.Ceiling(totalRows / 65535)
            For sheetIdx As Integer = 2 To sheetCount
                Dim newSheet As Excel.Worksheet = _ExcelWrkb.Sheets.Add(After:=_ExcelWrks)
                _ExcelWrks = newSheet
                ' 写入新表表头
                For colIndex As Integer = 0 To _Colonne.Count - 1
                    .Cells(1, colIndex + 1).Value = _Colonne(colIndex).Label
                Next
                .Range("A1").Resize(1, _Colonne.Count).NumberFormat = "@"
                ' 计算当前批次数据范围
                Dim startRowInArray As Integer = (sheetIdx - 1) * 65535
                Dim rowsToWrite As Integer = Math.Min(65535, totalRows - startRowInArray)
                ' 复制对应数据到临时数组
                Dim tempArray(rowsToWrite - 1, _Colonne.Count - 1) As Object
                Array.Copy(dataArray, startRowInArray * _Colonne.Count, tempArray, 0, rowsToWrite * _Colonne.Count)
                ' 写入临时数组数据
                .Cells(currentRow, 1).Resize(rowsToWrite, _Colonne.Count).Value = tempArray
            Next
        End If

        .Range("A1").Activate()
        _ExcelApp.Visible = True
    End With
End Sub

方案2：调整剪贴板批次并增加延迟（兼容原有逻辑） #

若必须保留剪贴板方式，可降低每批次数据量，并增加延迟确保剪贴板写入完成，同时移除不必要的Select操作：

' 修改原代码中批次处理的部分
If k = 50 OrElse j = _Rv.Count - 1 Then ' 将批次从100条改为50条
    System.Windows.Forms.Clipboard.SetDataObject(sb.ToString, True)
    System.Threading.Thread.Sleep(200) ' 增加200ms延迟，确保剪贴板数据就绪
    ' 直接调用Range的PasteSpecial，无需Select
    Me._ExcelWrks.Range("A" & CurRow).PasteSpecial()
    CurRow += k
    k = 0
    sb.Clear() ' 使用Clear替代Remove更高效
End If

方案3：移除所有Activate/Select操作 #

原代码中大量Activate()、Select()操作是低效且易出错的根源，所有单元格操作都可直接通过Cells或Range对象完成，无需依赖Excel的活动单元格状态。

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