时间戳

首页 > 解决方案 > 如何粘贴到右边的下一个空单元格？

excel - 如何粘贴到右边的下一个空单元格？

问题描述

我正在尝试从具有偏移量和过去值的匹配单元格值中复制值，并在右侧的下一个空单元格中。我收到错误“类型不匹配”

Dim ThisCell1 As Range
Dim ThisCell2 As Range
Dim LCol As Long
  Application.ScreenUpdating = False
  For Each ThisCell1 In Sheets("sheet1").Range("A1:A1089")
        For Each ThisCell2 In Sheets("sheet0").Range("b2:b3392")
            If ThisCell2.Value = ThisCell1.Value Then

                ThisCell2.Offset(0, 1).Copy

                ThisCell1.End(xlToLeft).Offset(0, 1).Select
                Selection.PasteSpecial Paste:=xlPasteValues
                Exit For
                End If
            Next ThisCell2
            Next ThisCell1
Application.ScreenUpdating = True

标签： excelvbarowsoffsetpaste

解决方案

这个 sub 可以满足您的要求，并且比使用您使用的双循环要快得多。它使用公式Match作为参数，它将查找在哪一行找到了匹配项。然后它将转到该行并找到最后使用的列并复制原始字符串的偏移量：

Dim ThisCell1 As Range
Dim ThisCell2 As Range
Dim LCol As Long
  Application.ScreenUpdating = False
        For Each ThisCell2 In Sheets("sheet0").Range("b2:b3392")
            If Not IsError(Application.Match(ThisCell2.Value, Sheets("Sheet1").Range("A1:A1089"))) Then
                    Sheets("Sheet1"). Cells(Application.Match(ThisCell2.Value, Sheets("Sheet1").Range("A1:A1089")), Columns.Count).End(xlToLeft).Offset(, 1).Value = ThisCell2.Offset(, 1)
                Exit For 'This insures you only ever get one match. Is that what is needed?
                End If
            Next ThisCell2
Application.ScreenUpdating = True

我不确定这是否是您正在寻找的确切逻辑，如果不告诉我。这是我能找到的最接近原始代码的近似值，将您的值与范围进行比较。

推荐阅读