Excel 2007 - 如果数据不存在，则将数据复制到另一个工作表

Question

我正在处理一个包含三张纸的文件。

第一张纸是这样的：

| ID | Data | Data | Data | Data | Sheet |

ID 是一个数字。数据可以是字母、数字或组合。工作表是一个下拉列表，其中包含其他两个工作表的名称。我想将 ID 和 4 个数据列复制到下拉列表中选择的工作表中，但前提是任一工作表上都不存在具有 ID 的行。

目前我的复制工作正常。我目前正在尝试扩展它，以便在复制之前检查它是否存在于当前选定的工作表中，然后从那里扩展它以检查两个工作表，但我对 VBA 和这个级别的 excel 非常陌生，所以我难住了。

到目前为止，这是我的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim csh As String
    Dim lastrow As Long
    Dim FindString As String
    Dim Rng As Range

    If ActiveCell.Column = 6 Then
        csh = ActiveCell.Value
        FindString = ActiveCell.Offset(0, -5).Value

        If Trim(FindString) <> "" Then
            If Len(csh) > 0 Then
                With Sheets(csh).Range("A:A")
                    Set Rng = .Find(What:=FindString, LookIn=xlValues, LookAt:xlWhole, _ 
                    SearchOrder: xlByRows, SearchDirection:=xlNext, MatchCase:False)
                    If Not Rng Is Nothing Then
                        MsgBox "ID already used"
                    Else
                        With Sheets(csh)
                            lastrow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                        End With
                            Sheets(csh).Cells(lastrow, 1).Value = ActiveCell.Offset(0, -5).Value
                            Sheets(csh).Cells(lastrow, 2).Value = ActiveCell.Offset(0, -4).Value
                            Sheets(csh).Cells(lastrow, 3).Value = ActiveCell.Offset(0, -3).Value
                            Sheets(csh).Cells(lastrow, 4).Value = ActiveCell.Offset(0, -2).Value
                            Sheets(csh).Cells(lastrow, 5).Value = ActiveCell.Offset(0, -1).Value
                    End If
                End With
            End If
        End If
    End If
End Sub

我对此的期望是，当我将一行的下拉列表从 A 更改为 B，然后返回 A，在第二个 A 上，我会收到一个消息框，上面写着“ID 已使用”。我不是，我不确定为什么。我认为我的逻辑是正确的。所有三张表中的 ID 都在 A 列中。

感谢任何帮助。

Answer 1

试试这个，根据需要更改工作表名称。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lastrow As Long
Dim FindString As String
Dim rng1 As Range, rng2 As Range
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Worksheets("A") 'change names as necessary
Set ws2 = Worksheets("B")

If Target.Column = 6 Then
    FindString = Target.Offset(0, -5).Value
    If Trim(FindString) <> "" Then
        If Len(Target) > 0 Then
            Set rng1 = ws1.Range("A:A").Find(What:=FindString, LookIn:=xlValues, LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            Set rng2 = ws2.Range("A:A").Find(What:=FindString)
            If Not rng1 Is Nothing Or Not rng2 Is Nothing Then
                MsgBox "ID already used"
            Else
                With Sheets(Target.Text)
                    lastrow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Cells(lastrow, 1).Resize(, 5).Value = Target.Offset(0, -5).Resize(, 5).Value
                End With
            End If
        End If
    End If
End If

End Sub

ActiveCell 的问题在于，在您更改了一个单元格（目标）之后，该单元格不再处于活动状态，因此两者是不同的东西。您可以通过将此代码添加到工作表模块、更改单元格并查看消息框返回的内容来轻松测试这一点。

Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox ActiveCell.Address
End Sub