[Q&A] 类Range的PasteSpecial方法无效

环境说明:

VS2013(C#) + Office2013

Bug说明:

range1.Copy(Type.Missing);

range2.PasteSpecial(Excel.XlPasteType.xlPasteValues, Excel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, false, false);

其中 range1 和 range2 来自两个 Excel.Applicaton,即想从一个 Excel.Applicaton1 中拷贝数据到另一个 Excel.Applicaton2 中,会出现类 Range 的 PasteSpecial 方法无效的异常;(在 C# 中通过 Excel.Application 可以 New 出来不同线程的 Excel 进程,然后各自处理数据)

参考解决方法:

先从 Excel.Applicaton1 的录制宏模拟该操作,然后根据宏代码(VBA)来调整代码;

在源 Excel.Application1 中进行拷贝的宏代码:

Sub 宏2()
    Range("F11:J11").Select
    Application.CutCopyMode = False
    Selection.Copy
End Sub

然后在另一个 Excel.Applicaton2 中粘贴的宏代码:

Sub 宏2()
    Range("G13").Select
    ActiveSheet.PasteSpecial Format:="文本", Link:=False, DisplayAsIcon:=False
End Sub

在粘贴时会弹出提示框:

不同Excel进程间的拷贝

注意,如果是在同一个 Excel 线程下打开的两个 Excel 文件,粘贴时是不会出现该提示框的,可以从任务管理器中查看是否是同一个 Excel 线程。

通过上面两端 VBA 代码可以知道,Excel 在处理不同进程之间的粘贴时,是通过 WorkSheet.PasteSpecial 方法处理的;所以在 C# 中将拷贝代码改为如下:

sourceRng.Copy();
targetRng.Select();
m_TargetSheet.PasteSpecial("文本", false, false);

即先对数据源 Range 进行 Copy,然后选择要粘贴的 Range,再进行粘贴。

转载于:https://www.cnblogs.com/memento/p/4228655.html

' 主过程:生成零件编码汇总表(修复日期显示问题) Public Sub GeneratePartsSummary() On Error GoTo ErrorHandler Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ' === 工作表设置 === Dim srcSheet As Worksheet, destSheet As Worksheet Set srcSheet = ThisWorkbook.Sheets("订单汇总") Set destSheet = ThisWorkbook.Sheets("推移表") ' === 获取源数据范围 === Dim lastRow As Long, lastCol As Long lastRow = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row lastCol = srcSheet.Cells(1, srcSheet.Columns.Count).End(xlToLeft).Column If lastRow < 2 Then MsgBox "源数据表中没有可处理的数据", vbExclamation Exit Sub End If ' === 读取源数据到数组 === Dim srcData As Variant srcData = srcSheet.Range(srcSheet.Cells(1, 1), srcSheet.Cells(lastRow, lastCol)).value ' === 创建字典存储汇总数据 === Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") dict.CompareMode = vbTextCompare ' === 确定日期列范围 === Dim firstDateCol As Long: firstDateCol = 4 Dim dateColCount As Long: dateColCount = lastCol - firstDateCol + 1 ' === 遍历源数据 === Dim i As Long, j As Long, partCode As String Dim values() As Double ReDim values(1 To dateColCount) For i = 2 To lastRow partCode = Trim(CStr(srcData(i, 1))) If partCode = "" Then GoTo NextRow If Not dict.Exists(partCode) Then For j = 1 To dateColCount values(j) = 0 Next j dict.Add partCode, values Else values = dict(partCode) End If For j = firstDateCol To lastCol Dim colIndex As Long: colIndex = j - firstDateCol + 1 If IsNumeric(srcData(i, j)) Then values(colIndex) = values(colIndex) + CDbl(srcData(i, j)) ElseIf srcData(i, j) <> "" Then values(colIndex) = values(colIndex) + HandleNonNumericValue(srcData(i, j)) End If Next j dict(partCode) = values NextRow: Next i ' === 准备目标数据 === Dim destData() As Variant ReDim destData(1 To dict.Count + 1, 1 To dateColCount + 2) ' 写入标题行(保留原始日期格式) destData(1, 1) = "零件编码" destData(1, 2) = "状态" For j = 1 To dateColCount ' 直接复制源表的日期值(保持原始格式) destData(1, j + 2) = srcData(1, j + firstDateCol - 1) Next j ' === 写入数据 === Dim keys As Variant, rowIndex As Long keys = dict.keys rowIndex = 2 For i = 0 To dict.Count - 1 destData(rowIndex, 1) = keys(i) destData(rowIndex, 2) = "订单" values = dict(keys(i)) For j = 1 To dateColCount destData(rowIndex, j + 2) = values(j) Next j rowIndex = rowIndex + 1 Next i ' === 写入目标表 === destSheet.Cells.Clear Dim outputRange As Range Set outputRange = destSheet.Range("A1").Resize(UBound(destData, 1), UBound(destData, 2)) outputRange.value = destData ' === 日期格式修复 === FixDateFormat destSheet, srcSheet, firstDateCol, lastCol ' === 格式设置 === FormatSummarySheet destSheet ExitProcedure: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Exit Sub ErrorHandler: MsgBox "错误 " & Err.Number & ": " & Err.Description & vbCrLf & _ "发生在 " & Erl, vbCritical Resume ExitProcedure End Sub ' === 日期格式修复函数 === Private Sub FixDateFormat(destSheet As Worksheet, srcSheet As Worksheet, firstDateCol As Long, lastCol As Long) ' 获取源表日期列的格式 Dim srcDateFormat As String On Error Resume Next srcDateFormat = srcSheet.Cells(1, firstDateCol).NumberFormat If Err.Number <> 0 Then srcDateFormat = "yyyy-mm-dd" On Error GoTo 0 ' 计算目标表日期列范围 Dim destFirstDateCol As Long: destFirstDateCol = 3 ' 目标表日期从C列开始 Dim dateColCount As Long: dateColCount = lastCol - firstDateCol + 1 ' 应用源表日期格式到目标表 With destSheet.Range(destSheet.Cells(1, destFirstDateCol), _ destSheet.Cells(1, destFirstDateCol + dateColCount - 1)) .NumberFormat = srcDateFormat ' 特殊处理:确保日期值正确显示 If InStr(srcDateFormat, "yy") > 0 Then .EntireColumn.AutoFit ' 自动调整列宽显示日期 End If End With ' 复制列宽设置(确保完全匹配源表) srcSheet.Range(srcSheet.Cells(1, firstDateCol), srcSheet.Cells(1, lastCol)).EntireColumn.Copy destSheet.Range(destSheet.Cells(1, destFirstDateCol), _ destSheet.Cells(1, destFirstDateCol + dateColCount - 1)).EntireColumn.PasteSpecial Paste:=xlPasteColumnWidths Application.CutCopyMode = False End Sub ' 辅助函数:处理非数值数据 Private Function HandleNonNumericValue(inputVal As Variant) As Double If IsNumeric(inputVal) Then HandleNonNumericValue = CDbl(inputVal) Else Select Case UCase(Trim(CStr(inputVal))) Case "N/A", "NA", "-", "" HandleNonNumericValue = 0 Case Else On Error Resume Next HandleNonNumericValue = Val(Replace(inputVal, ",", "")) If Err.Number <> 0 Then HandleNonNumericValue = 0 On Error GoTo 0 End Select End If End Function ' 格式设置子过程 Private Sub FormatSummarySheet(ws As Worksheet) On Error Resume Next With ws ' 设置状态列格式 .Columns(2).NumberFormat = "@" ' 设置数字格式(跳过日期标题行) Dim dataStartRow As Long: dataStartRow = 2 Dim dataStartCol As Long: dataStartCol = 3 Dim lastDataRow As Long: lastDataRow = .Cells(.Rows.Count, 1).End(xlUp).Row Dim lastDataCol As Long: lastDataCol = .Cells(1, .Columns.Count).End(xlToLeft).Column If lastDataRow > 1 And lastDataCol >= dataStartCol Then .Range(.Cells(dataStartRow, dataStartCol), .Cells(lastDataRow, lastDataCol)).NumberFormat = "#,##0" End If ' 添加表头格式 With .Rows(1) .Font.Bold = True .Interior.Color = RGB(200, 200, 255) .HorizontalAlignment = xlCenter End With ' 安全冻结窗格 SafeFreezeHeader ws End With End Sub ' 安全冻结窗格子过程 Private Sub SafeFreezeHeader(ws As Worksheet) On Error Resume Next If ws.Visible = xlSheetVisible And Not ws.ProtectContents Then Dim prevSheet As Worksheet Set prevSheet = ActiveSheet ws.Activate With ActiveWindow .FreezePanes = False .SplitRow = 1 .FreezePanes = True End With prevSheet.Activate End If End Sub 该段代码已经能够实现数据筛选求和导出的功能,但是列标题中的日期值需要修改。列标题中的日期值修改为:利用交互窗口键入一个日期值,列标题中的日期值是从该日开始,往后顺延15天(包含该日),同时需要考虑日期在顺延过程中应该与实际日历相对应。请尽量保留上述代码的结构,重新生成一份完整的代码
最新发布
07-11
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值