部分行从一个 sheet 复制到另一个和混合类型数据单元比较

Question

我有一个有效的宏，如果第一个单元格行（A 列）中的值与目标 sheets 单元格 = B1 中的值匹配，它基本上从基础 sheet 中剪切行，并且将其粘贴到目标 sheet 的第一个空行（检查 A 列中的单元格）。但是由于我的Excel的功能需要稍微改变，所以我需要做一些调整，但是到目前为止我的所有尝试都失败了。

这是工作代码：

Sub RowCopy()

Application.ScreenUpdating = False

Set shtarget = Sheets("TargetSheet")

Set shBase = Sheets("BaseSheet")

For i = shBase.Range("A" & shBase.Rows.Count).End(xlUp).Row To 1 Step -1
    If shBase.Cells(i, 1).Value = shtarget.Cells(1, 2).Value Then
    shBase.Rows(i).EntireRow.Cut
    shtarget.Rows(shtarget.Cells(shtarget.Rows.Count, 1).End(xlUp).Row + 1).EntireRow.Insert Shift:=xlDown
    shBase.Rows(i).EntireRow.Delete

End If

Next i

Application.CutCopyMode = False

Set shtarget = Nothing
Set shBase = Nothing

Application.ScreenUpdating = True

End Sub

以下是我正在处理的问题：

第 1 期：

如果单元格 B1 包含混合文本和数字以及 (dash/comma/space)，该代码将不起作用，例如："white - 32"。我试过使用 Variant，但它每次都不能正常工作，并且使数据排序非常慢，尤其是在数据量很大的情况下。

这里我尝试用 StrComp 比较两个单元格，代码本身没有显示任何错误，但也没有做它应该做的事情 - 即 - 将数据复制到目标 sheet:

Sub RowCopy()

Application.ScreenUpdating = False

Set shtarget = Sheets("TargetSheet")

Set shBase = Sheets("BaseSheet")

For i = shBase.Range("A" & shBase.Rows.Count).End(xlUp).Row To 1 Step -1
    If StrComp(shBase.Cells(i, 1).Value, shtarget.Cells(1, 2).Value) = 0 Then
    shBase.Rows(i).EntireRow.Cut
    shtarget.Rows(shtarget.Cells(shtarget.Rows.Count, 1).End(xlUp).Row + 1).EntireRow.Insert Shift:=xlDown
    shBase.Rows(i).EntireRow.Delete

End If

Next i

Application.CutCopyMode = False

Set shtarget = Nothing
Set shBase = Nothing

Application.ScreenUpdating = True

End Sub

我错过了什么？
有没有更有效的方法来比较单元格中的混合类型数据？

第 2 期：

使用现有代码，复制整行会干扰目标 sheet 页面右侧的数据，因为它会将行向下移动。但是，有必要从基础 sheet cut/copy 行的特定部分（例如：来自 A2:J2）并仅粘贴目标 sheets 区域中从 A 到 J 的数据, 而不会弄乱目标的其他部分 sheet。它应该更像是向下移动 1 行，而不是插入和移动行，这在现有代码中正在发生。
我已经尝试用 Range(A2:J2) 替换 "EntireRow"，但它只给我留下了必要的数据丢失和错误的数据复制到我的目标 sheet。

如何在下面的代码中定义行的特定范围以仅粘贴目标 sheet 中的数据，同时不插入新行（并且不弄乱目标之外的其他数据 sheets A:J 范围)?

Sub RowCopy()

Application.ScreenUpdating = False

Set shtarget = Sheets("TargetSheet")

Set shBase = Sheets("BaseSheet")

For i = shBase.Range("A" & shBase.Rows.Count).End(xlUp).Row To 1 Step -1
    If shBase.Cells(i, 1).Value = shtarget.Cells(1, 2).Value Then
    shBase.Rows(i).EntireRow.Cut
    shtarget.Rows(shtarget.Cells(shtarget.Rows.Count, 1).End(xlUp).Row + 1).EntireRow.Insert Shift:=xlDown
    shBase.Rows(i).EntireRow.Delete

End If

Next i

Application.CutCopyMode = False

Set shtarget = Nothing
Set shBase = Nothing

Application.ScreenUpdating = True

End Sub

Answer 1

我没有发现搜索（例如）"white - 32"...

有任何问题

Sub RowCopy()

    Dim shtarget As Worksheet, shBase As Worksheet
    Dim vGet, cDest As Range, i As Long

    Application.ScreenUpdating = False

    Set shtarget = Sheets("TargetSheet")
    Set shBase = Sheets("BaseSheet")

    'get initial paste position
    Set cDest = shtarget.Cells(shtarget.Rows.Count, 1).End(xlUp).Offset(1, 0)
    'value being searched for
    vGet = shtarget.Cells(1, 2).Value

    For i = shBase.Range("A" & shBase.Rows.Count).End(xlUp).Row To 1 Step -1

        If shBase.Cells(i, 1).Value = vGet Then
            shBase.Cells(i, 1).Resize(1, 10).Copy cDest 'copy 10 columns
            shBase.Rows(i).EntireRow.Delete
            Set cDest = cDest.Offset(1, 0)
        End If

    Next i

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

部分行从一个 sheet 复制到另一个和混合类型数据单元比较

Partial row copying from one sheet to another and mixed type data cell comparing

vba

excel

copy-paste

string-comparison