Question

我正在处理一张有三张纸的文件。

第一张表格如下：

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

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

目前我的复印工作正常。我目前正在尝试扩展它，以便在复制之前检查它是否存在于当前选定的工作表中，然后从那里扩展它以检查两个工作表，但我对VBA非常新，并且擅长这个级别所以我很难过。

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

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时，在第二个AI上会有一个消息框说“＆＃34; ID已经使用＆＃” 34 ;.我不是，我不确定为什么。我认为我的逻辑是正确的。所有三张表中的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

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

1 个答案: