如何调整单元格的亮度(xx,columns.count)

时间:2019-02-19 11:47:57

标签: excel vba

该问题是已经回答的问题(Copy offset range)的后续问题。如何Dim Cells(13, Columns.Count),这样就不必一直在下一个宏中更改“ 13”,而只需一次。

像这样吗?

Dim cello As Cell
Set cello = Cells(13, Columns.Count)

部分来自原始代码:

StartRange.MergeArea.Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll

StartRange.Offset(1, 0).Resize(17, 2).Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(1, 0).PasteSpecial xlPasteAll

StartRange.Offset(18, 0).MergeArea.Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(18, 0).PasteSpecial xlPasteAll

StartRange.Offset(19, 0).Resize(2, 2).Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(19, 0).PasteSpecial xlPasteAll

StartRange.Offset(150, 0).MergeArea.Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(150, 0).PasteSpecial xlPasteAll

StartRange.Offset(151, 0).Resize(4, 2).Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(151, 0).PasteSpecial xlPasteAll

--------------编辑-------------------

根据建议的解决方案:

Sub CopyPaste()
Application.ScreenUpdating = False

Dim StartRange As Range
Dim pasteSheet As Worksheet
Dim cello As Range

Set pasteSheet = Worksheets("Calculation")

Set cello = Cells(13, Columns.Count)

Set StartRange = Worksheets("Calculation").Range("D13")

StartRange.MergeArea.Copy
pasteSheet.cello.End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll

StartRange.Offset(1, 0).Resize(17, 2).Copy
pasteSheet.cello.End(xlToLeft).Offset(1, 0).PasteSpecial xlPasteAll

StartRange.Offset(18, 0).MergeArea.Copy
pasteSheet.cello.End(xlToLeft).Offset(18, 0).PasteSpecial xlPasteAll

StartRange.Offset(19, 0).Resize(2, 2).Copy
pasteSheet.cello.End(xlToLeft).Offset(19, 0).PasteSpecial xlPasteAll

StartRange.Offset(150, 0).MergeArea.Copy
pasteSheet.cello.End(xlToLeft).Offset(150, 0).PasteSpecial xlPasteAll

StartRange.Offset(151, 0).Resize(4, 2).Copy
pasteSheet.cello.End(xlToLeft).Offset(151, 0).PasteSpecial xlPasteAll

Set StartRange = Nothing
Set pasteSheet = Nothing
Set cello = Nothing

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

但是运行此代码会出现错误“找不到方法或数据成员”?指向pasteSheet.cello.End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll

中的“大提琴”

1 个答案:

答案 0 :(得分:0)

我想出的解决方案:

Sub CopyPaste()
Application.ScreenUpdating = False

Dim StartRange As Range
Dim cello As Range

Set cello = Worksheets("Calculation").Cells(13, Columns.Count)

Set StartRange = Worksheets("Calculation").Range("D13")

StartRange.MergeArea.Copy
cello.End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll

StartRange.Offset(1, 0).Resize(17, 2).Copy
cello.End(xlToLeft).Offset(1, 0).PasteSpecial xlPasteAll

StartRange.Offset(18, 0).MergeArea.Copy
cello.End(xlToLeft).Offset(18, 0).PasteSpecial xlPasteAll

StartRange.Offset(19, 0).Resize(2, 2).Copy
cello.End(xlToLeft).Offset(19, 0).PasteSpecial xlPasteAll

StartRange.Offset(150, 0).MergeArea.Copy
cello.End(xlToLeft).Offset(150, 0).PasteSpecial xlPasteAll

StartRange.Offset(151, 0).Resize(4, 2).Copy
cello.End(xlToLeft).Offset(151, 0).PasteSpecial xlPasteAll

Set StartRange = Nothing
Set pasteSheet = Nothing
Set cello = Nothing

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub