VBA给合并单元格黏贴赋值

来源：互联网发布：js中数组存储对象编辑：程序博客网时间：2024/06/10 14:54

由于EXCEL中通过剪切板给合并后的单元格赋值时候会出现如下错误

所以在vba中也一定不能了，其实可以通过一种workaround的方式来间接实现这个需求，实现步骤如下

一、拆分合并的单元格

二、给第一个单元格赋值

三、合并单元格

下面是具体的使用

Sub tttt()
Dim i, g
Dim objData As DataObject
Dim sHTML As String
Dim sSelAdd As String
Const sTEMP As String = "||||"
Application.EnableEvents = False
g = ActiveSheet.UsedRange.Rows.Count
For i = 9 To g

'拆分单元格
Range("E" & (i) & ":V" & (i)).Select
'With Selection
'.HorizontalAlignment = xlCenter
'.VerticalAlignment = xlTop
'.WrapText = True
'.Orientation = 0
' .AddIndent = False
'.IndentLevel = 0
' .ShrinkToFit = False
' .ReadingOrder = xlContext
' .MergeCells = False
' End With
Selection.UnMerge


If True Then
If LCase(Left(Range("E" & (i)).Value, 6)) = "<html>" Then
Set objData = New DataObject
sHTML = Range("E" & (i)).Value
sHTML = Replace(sHTML, "<br />", sTEMP)
objData.SetText sHTML
objData.PutInClipboard

ActiveSheet.Paste Destination:=Range("E" & (i))
'合并单元格
Range("E" & (i) & ":V" & (i)).Select
' With Selection
'.HorizontalAlignment = xlCenter
'.VerticalAlignment = xlTop
' .WrapText = True
' .Orientation = 0
' .AddIndent = False
' .IndentLevel = 0
' .ShrinkToFit = False
' .ReadingOrder = xlContext
' .MergeCells = False
' End With
Selection.Merge

End If
End If
Next
Application.EnableEvents = True
End Sub