将图例中的单元格格式转换为另一张表格中的数据集

时间：2016-05-10 13:04:21

标签： excel vba excel-vba

在工作表1上是一个图例，每10行包含A列中的唯一值。在接下来的五列中的每个值的右侧是一系列颜色填充的单元格，它们向下延伸十行到下一个唯一值的开头。每个5x10区域的颜色填充是我想要传输到数据集表的颜色。

数据集位于Sheet2上。整个粘贴区域填充虚拟值，以便宏正常工作。在我所拥有的宏中定义的“粘贴到”列中，经常包含一个已经存在于图例中的值，我想要传输颜色填充。 “粘贴到”列位于粘贴区域内，因此突出显示的区域可能会重叠，这是必要的。

使用宏，我想将图例中的5x10区域复制并粘贴到数据集表格中的相应区域。因此，如果数据集表中存在一个值并匹配图例中的一个唯一值，我希望将从左到右，从上到下，重叠的顺序粘贴唯一值5x10区域。

我尝试使用Find方法对数据集中的值进行查找，并使用offset函数告诉宏在哪里按单元格粘贴。虽然这确实有效，但即使只有几列和有限的图例，它也是过程密集型的。

如何提高效率？数组？我已经玩过使用十六进制值并将它们转换为单元格填充，如果这样做会更有效率。有任何想法吗？这是我到目前为止所做的：

＆＃13;
＆＃13; 
Sub LegTra2()

Dim RngMap As Range, RngLeg As Range, RngCom As Range, RngTar As Range

Application.ScreenUpdating = False 
Application.CutCopyMode = False

Set RngMap = Sheet2.Range("$A$1:$A$100,$D$1:$D$100,$G$1:$G$100") 'Columns spaced closer than width of legend fill to provide for overlap
Set RngLeg = Sheet1.Range("$A$1:$F$41")

For Each RngCom In RngMap
    Set RngTar = RngLeg.Find(What:=RngCom, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If Not RngTar Is Nothing Then
        RngTar.Offset(0, 1).Copy
        RngCom.Offset(0, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(0, 2).Copy
        RngCom.Offset(0, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(0, 3).Copy
        RngCom.Offset(0, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(0, 4).Copy
        RngCom.Offset(0, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(0, 5).Copy
        RngCom.Offset(0, 4).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(1, 1).Copy
        RngCom.Offset(1, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(1, 2).Copy
        RngCom.Offset(1, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(1, 3).Copy
        RngCom.Offset(1, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(1, 4).Copy
        RngCom.Offset(1, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(1, 5).Copy
        RngCom.Offset(1, 4).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(2, 1).Copy
        RngCom.Offset(2, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(2, 2).Copy
        RngCom.Offset(2, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(2, 3).Copy
        RngCom.Offset(2, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(2, 4).Copy
        RngCom.Offset(2, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(2, 5).Copy
        RngCom.Offset(2, 4).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(3, 1).Copy
        RngCom.Offset(3, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(3, 2).Copy
        RngCom.Offset(3, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(3, 3).Copy
        RngCom.Offset(3, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(3, 4).Copy
        RngCom.Offset(3, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(3, 5).Copy
        RngCom.Offset(3, 4).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(4, 1).Copy
        RngCom.Offset(4, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(4, 2).Copy
        RngCom.Offset(4, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(4, 3).Copy
        RngCom.Offset(4, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(4, 4).Copy
        RngCom.Offset(4, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(4, 5).Copy
        RngCom.Offset(4, 4).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(5, 1).Copy
        RngCom.Offset(5, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(5, 2).Copy
        RngCom.Offset(5, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(5, 3).Copy
        RngCom.Offset(5, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(5, 4).Copy
        RngCom.Offset(5, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(5, 5).Copy
        RngCom.Offset(5, 4).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(6, 1).Copy
        RngCom.Offset(6, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(6, 2).Copy
        RngCom.Offset(6, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(6, 3).Copy
        RngCom.Offset(6, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(6, 4).Copy
        RngCom.Offset(6, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(6, 5).Copy
        RngCom.Offset(6, 4).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(7, 1).Copy
        RngCom.Offset(7, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(7, 2).Copy
        RngCom.Offset(7, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(7, 3).Copy
        RngCom.Offset(7, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(7, 4).Copy
        RngCom.Offset(7, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(7, 5).Copy
        RngCom.Offset(7, 4).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(8, 1).Copy
        RngCom.Offset(8, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(8, 2).Copy
        RngCom.Offset(8, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(8, 3).Copy
        RngCom.Offset(8, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(8, 4).Copy
        RngCom.Offset(8, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(8, 5).Copy
        RngCom.Offset(8, 4).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(9, 1).Copy
        RngCom.Offset(9, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(9, 2).Copy
        RngCom.Offset(9, 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(9, 3).Copy
        RngCom.Offset(9, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(9, 4).Copy
        RngCom.Offset(9, 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        RngTar.Offset(9, 5).Copy
        RngCom.Offset(9, 4).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    End If
Next

End Sub
＆＃13;
＆＃13;
＆＃13;

1 个答案:

答案 0 :(得分：0)

这应该取代你的大量复制和粘贴内容：

Dim i As Integer, j As Integer

For i = 0 To 10 Step 1

    For j = 0 To 4 Step 1

        RngTar.Offset(i, j + 1).Copy
        RngCom.Offset(i, j).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    Next j
Next i
相关问题
最新问题