Question

想想我的问题：单元格FS3:FS33显示目前餐厅座位3 to 33（这些是唯一的座位）中的客户的客户收据。当他们离开他们的收据时离开单元格FS3:FS33并转到垃圾箱。新客户来来往往，随着他们的来来往往FS3:FS33向下填充到最后一列（即没有间隙，他们将从FS3填写下来）。每张收据都是唯一的，需要记录并保存在C：C中另一张纸上另一列的最后一行。

此问题已得到解答，但最后一个问题是我没有更新 - 请参阅下文

该子模块

中的组合

Sub hithere3()
Dim Rng As Range
Dim Unique As Boolean

For Each Rng In Worksheets("Sheet8").Range("FS3:FS30") 'for each cell     in     your B1 to B30 range, sheet1
Unique = True 'we'll assume it's unique
Lastunique = Worksheets("TRADES").Range("C:C").Find("*",     SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 3 To Lastunique 'for each cell in the unique ID cache
    If Rng.Value = Worksheets("TRADES").Cells(i, 3).Value Then 'we       check    if it is equal
        Unique = False 'if yes, it is not unique
    End If
Next
If Unique Then Worksheets("TRADES").Cells(Lastunique + 1, 3) = Rng 'adds    if it is unique
Next
End Sub

使用工作表更改事件中的循环检查

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("FS3:FS33")) Is Nothing Then
'Do nothing '
Else
Call hithere3
End If
End Sub

除了只在我选择FS3中的一个单元格时才更新：FS33

有谁能建议如何克服这个问题？

解决方案

Private Sub Worksheet_calculate()
If Range("FS3:FS33") Is Nothing Then
'Do nothing'
Else
 Call hithere3
End If
End Sub

Answer 1

添加作为答案，因为评论不会让我正确格式化代码部分。 Jon假设你正在使用user3819867上面的代码，你需要做的就是使用intersect更改workheet_change模块是 Private Sub WorkSheet_Change(ByVal Target As Range) If Intersect(Target, Range("B1:B30")) Is Nothing Then 'Do nothing ' else Call ertdfgcvb end if End Sub

编辑补充说我真的不需要在这里调用单独的程序。将程序代码直接放在这里，因为它非常小，如果您决定调整并使用“目标”，则会更容易阅读

Answer 2

我为你做了一个简单的解决方案。如果您的数据集相对较小，则不会在每个值输入（Worksheet_Change事件）上运行它。

Sub ertdfgcvb()
Dim rng As Range
Dim Unique As Boolean

For Each rng In Worksheets("Sheet1").Range("B1:B30") 'for each cell in your B1 to B30 range, sheet1
    Unique = True 'we'll assume it's unique
    Lastunique = Worksheets("Sheet2").Range("B:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For i = 1 To Lastunique 'for each cell in the unique ID cache
        If rng.Value = Worksheets("Sheet2").Cells(i, 2).Value Then 'we check if it is equal
            Unique = False 'if yes, it is not unique
        End If
    Next
    If Unique Then Worksheets("Sheet2").Cells(Lastunique + 1, 2) = rng 'adds if it is unique
Next
End Sub

电话会是：

Private Sub WorkSheet_Change(ByVal Target As Range)
Call ertdfgcvb
End Sub

如果您有更大的数据集，则必须改为引用目标。

VBA将工作表1的B列中的新值粘贴到sheet2中的B的最后一个空单元格

2 个答案: