宏仅复制不同工作表中匹配值的格式

时间:2016-04-06 21:20:44

标签: excel vba excel-vba macros

提前感谢您的帮助。 在Excel 2016中,我有一个工作簿,其中包含3张标签,分别标记为上午9点,下午12点和下午3点。 我有列A到AF,每行都设置了值和格式。 现在,在对StackOverflow进行了一些研究之后,我发现了一个宏,它在9am表中的A列中查找最后找到的值,然后用它的单元格格式复制该值,以及其余的值。行单元格(直到列AF),进入12pm表格。 代码如下所示:

Private Sub CopyDataAndFormat12pm()
Dim NewDataRng As Range 'For 12pm
Dim cel As Range 'For 12pm
Dim OldDataRng As Range 'For 9am
Dim MatchingValueCell As Range 'For 9am
Dim lastrow As Long

With Sheets("9am")
    lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    Set NewDataRng = .Range("A2:A" & CStr(lastrow))
End With

With Sheets("12pm")
    lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    Set OldDataRng = .Range("A2:A" & CStr(lastrow))
End With

For Each cel In NewDataRng
    Set MatchingValueCell = OldDataRng.Find(What:=cel.Value, _
    After:=OldDataRng.Cells(OldDataRng.Cells.Count))
    If Not MatchingValueCell Is Nothing Then _
    cel.Resize(1, 8).Copy MatchingValueCell

Next cel
End sub

这很好用,除了我还有一个宏贴上12pm报告的最新值列表并自动为我格式化,12pm表可能有一些列的新值(特别是列C, I,J和K)我需要保留新值。 基本上,我需要修改此代码,以便它只将行的格式(对于每行的A列:AF)粘贴到新找到的12pm表中,以找到匹配的值。 我尝试将代码修改为:

    For Each cel In NewDataRng
    Set MatchingValueCell = OldDataRng.Find(What:=cel.Value, _
    After:=OldDataRng.Cells(OldDataRng.Cells.Count))
    If Not MatchingValueCell Is Nothing Then _
    cel.Copy
    cel.Resize(1, 31).PasteSpecial Paste:=xlPasteFormats

但是当我运行它时,它会疯狂地闪烁屏幕,因为它运行代码,看起来它正在做我想要的,但是当代码完成编译时,没有任何东西被保存,看起来代码永远不会运行。 / p>

很抱歉,如果这不是一个好的解释,如果您需要更多代码,请询问,我将非常乐意尽快提供。

非常感谢你能帮助我!

此致 贝迪

1 个答案:

答案 0 :(得分:0)

我没有任何数据可以对此进行测试,但请尝试以下内容......

For Each cel In NewDataRng
    Set MatchingValueCell = OldDataRng.Find(What:=cel.Value, _
    After:=OldDataRng.Cells(OldDataRng.Cells.Count))
    If Not MatchingValueCell Is Nothing Then _
    Sheets("9am").Rows(MatchingValueCell.Row).Copy
    Sheets("12pm").Rows(cel.Row).PasteSpecial Paste:=xlPasteFormats
Next cel