VBA代码无法复制Excel表格格式的解决方案
在你的代码中,粘贴格式的操作无法成功复制'销售明细表'中的格式到'销售记录管理',原因是在粘贴操作之前,剪贴板中没有保存'销售明细表'的格式。
为了解决这个问题,可以使用PasteSpecial方法的xlPasteAll参数来复制数据和格式。修改代码如下:
Private Sub CommandButton2_Click()
On Error Resume Next
With Sheets("销售明细表")
r = .Cells(.Cells.Rows.Count, "B").End(3).Row
arr = .Range("B10:U" & r)
.Range("B10:U" & r).Copy ' 复制数据和格式
End With
Dim str1 As String, str2 As String, str3 As String, str4 As String, str5 As String, str6 As String, str7 As String, str8 As String, str9 As String, str10 As String
With Me
str1 = .TextBox7.Value '窗体查询条件赋值给str1
str2 = .TextBox8.Value
str3 = .TextBox9.Value
str4 = .TextBox10.Value
str5 = .TextBox11.Value
str6 = .TextBox12.Value
str7 = .TextBox13.Value
str8 = .TextBox14.Value
str9 = .TextBox15.Value
str10 = .TextBox16.Value
End With
If str1 = "" And str2 = "" And str3 = "" And str4 = "" And str5 = "" And str6 = "" And str7 = "" And str8 = "" And str9 = "" And str10 = "" Then
MsgBox "请输入至少一个查询条件,以方便系统为您查询相应数据!", vbInformation, "系统提示"
Exit Sub
End If
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
For i = 1 To UBound(arr)
If (str1 = "" Or (arr(i, 1) Like "*" & str1 & "*" And str1 <> "")) _
And (str2 = "" Or (arr(i, 2) Like "*" & str2 & "*" And str2 <> "")) _
And (str3 = "" Or (arr(i, 3) Like "*" & str3 & "*" And str3 <> "")) _
And (str4 = "" Or (arr(i, 4) Like "*" & str4 & "*" And str4 <> "")) _
And (str5 = "" Or (arr(i, 5) Like "*" & str5 & "*" And str5 <> "")) _
And (str6 = "" Or (arr(i, 9) Like "*" & str6 & "*" And str6 <> "")) _
And (str7 = "" Or (arr(i, 10) Like "*" & str7 & "*" And str7 <> "")) _
And (str8 = "" Or (arr(i, 13) Like "*" & str8 & "*" And str8 <> "")) _
And (str9 = "" Or (arr(i, 18) Like "*" & str9 & "*" And str9 <> "")) _
And (str10 = "" Or (arr(i, 19) Like "*" & str10 & "*" And str10 <> "")) _
Then
m = m + 1
For j = 1 To UBound(arr, 2)
brr(m, 1) = m
brr(m, j + 1) = arr(i, j)
Next
End If
Next
With Sheets("销售记录管理")
If m > 0 Then
.Range("A10:U1048576").ClearContents
.Range("A10").Resize(UBound(brr), UBound(brr, 2)).Value = brr ' 将数据填充到目标范围
.Range("A10").Resize(UBound(brr), UBound(brr, 2)).PasteSpecial Paste:=xlPasteAll ' 粘贴数据和格式
MsgBox "数据查询完毕", vbInformation, "系统提示"
Else
.Range("A10:U1048576").ClearContents
MsgBox "抱歉,没有符合条件的数据,请您再次查证所录入的查询条件是否存在!", vbInformation, "系统提示"
End If
End With
End Sub
这样修改后的代码会将数据和格式一起复制到'销售记录管理'表。请注意,这里使用xlPasteAll参数而不是xlPasteFormats来粘贴数据和格式。
原文地址: https://www.cveoy.top/t/topic/bOmI 著作权归作者所有。请勿转载和采集!