检查是否已从Excel文件（VBA）中复制/粘贴数据

Question

我将首先讲述我对此代码的意图

在我的工作中，我们必须打开当天发送的每个销售订单，并检查手动发货的itens。 由于我非常费时地创建了一个工作表，它将在每个销售订单中查找itens并复制/粘贴到我的主人，这样我就可以知道我需要得到什么。

然而，对于我的工作表，我不得不在销售订单中进行一些更改，但现在我想创建一个错误检查，如果它打开的文件是较旧的SO它会告诉我它的订单号所以以后我可以检查一下。 此外，我想检查是否由于某种原因在那个SO中找不到任何东西。

现在生病解释我的代码做了什么（我对编码和excel vba有一点了解，所以请不要判断我的丑陋脚本）

使用范围中单元格的值，它将打开与其值匹配的文件夹和文件，然后查找特定范围和特定单元格值，在本例中为“Perfil”，如果此值为发现它会复制一些细胞。

在查找该文件后，它将打开另一个文件并执行相同操作。

然而，如果找不到“Perfil”，它将不会复制并粘贴任何内容，它只会转到下一个文件。

Public Sub test()
On Error GoTo Errormsg

Dim wbk As Workbook
Dim Fonte As Workbook
Dim Dest As Workbook
Dim Filename As String
Dim FolderName As String
Dim Arquivo As String
Dim Path As String
Dim celula As Range
Dim cll As Range
Dim Inicio As Range
Dim Fim As Range
Dim OffInicio As Range
Dim OffFim As Range
Dim busca As Range


Application.ScreenUpdating = False

Set Dest = Workbooks("testee.xlsm")
Path = 'My file path

lrow = Sheets(1).Range("A" & Sheets(1).Rows.Count).End(xlUp).Row

For Each celula In Dest.Worksheets(1).Range("A3:A" & lrow)

    Dest.Sheets(1).Activate
    Pedido = Cells(celula.Row, 1)
    FolderName = Pedido & "*"
    Arquivo = "\" & Pedido

    Folder = Dir(Path & FolderName, vbDirectory)
    Filename = Dir(Path & Folder & Arquivo & "*.xlsx")

    Set wbk = Workbooks.Open(Path & Folder & "\" & Filename, 0)
    Set Fonte = Workbooks(Filename)

    Fonte.Activate


    Set Inicio = Fonte.Worksheets(1).Cells.Find(what:="MODO DE FIXAÇÃO DO PRODUTO")
    Set Fim = Fonte.Worksheets(1).Cells.Find(what:="OBSERVAÇÕES")
    Set OffInicio = Inicio.Offset(1, 0)
    Set OffFim = Fim.Offset(-1, 1)
    Set busca = Range(OffInicio, OffFim).Columns(5)
    Set check = Range(OffInicio, OffFim).Columns(9)

        Range(OffInicio, OffFim).Columns(5).Select

        Set busca = Selection

    For Each cl In busca
        tipo = Cells(cl.Row, 5).Value

        If tipo = "Perfil" Then

        tamanho = Cells(cl.Row, 6).Value
        expessura = Cells(cl.Row, 11).Value
        cor = Cells(cl.Row, 12).Value

        lrow2 = Dest.Sheets(2).Range("D" & Dest.Sheets(2).Rows.Count).End(xlUp).Row
        linha = lrow2 + 1

        Dest.Sheets(2).Range("D" & linha).Value = Pedido
        Dest.Sheets(2).Range("E" & linha).Value = tamanho
        Dest.Sheets(2).Range("H" & linha).Value = cor

        End If
Next cl

End If

Next celula

Errormsg:
lrow2 = Dest.Sheets(2).Range("D" & Dest.Sheets(2).Rows.Count).End(xlUp).Row
linha = lrow2 + 1

Dest.Sheets(2).Range("D" & linha).Value = Pedido
Dest.Sheets(2).Range("E" & linha).Value = "Pedido com modelo Antigo"

End Sub

我想知道没有数据被复制的文件，所以我可以手动检查并查看它为什么不是。 要做到这一点，我应该检查是否在该文件中是否已将任何数据复制并粘贴在我的主表中，如果没有进行任何操作，它将在单元格中发送一条消息，告知其编号，以便我稍后再查看。

现在是我的问题： 我不知道是否有可能检查是否有任何东西从该文件中粘贴，如果可能的话，我是怎么做到的？

我不能检查“Perfil”是否存在，因为对于我的工作表，我必须在具有我需要的数据的工作表中更改一些内容，并且“perfil”不是旧版本的内容。

同样在我的新版本中，“Perfil”并不是该列可以拥有的唯一值，因此我无法检查是否在那里找不到perfil。

Answer 1

有几种方法可以检查工作簿中是否有任何更改。我建议这种方法：

在任何（新的或现有的）标准模块中，在模块顶部或附近添加公共变量声明：

Public wksChanged As Boolean

对于要监控更改的每个工作表，通过右键单击 工作表标签并点击{打开工作表模块{1}}：

...然后添加此过程（到每个适用的工作表模块）：

View Code

首次打开工作簿时，

Private Sub Worksheet_Change(ByVal Target As Range) wksChanged = True End Sub 将默认为wksChanged，而当更改任何单元格时，将更改为False 。你可以重置＆＃34;它随时都有：

True