vba 从单元格捕获数据并将值粘贴到不同工作表上的另一个单元格中

capture data from a cell and paste the value into another cell on a different worksheet

提问by donviti

I'm making this more challenging in my head than it has to be, but since I haven't been using vba or excel recently I'm using this as my excuse. Please don't question the methodology :) as this is only a small step I'm trying eliminate for someone to save some time, until I can redo the entire process. I would do the reverse, but this is an invoice of sorts that they are using....

我让这件事在我的脑海中变得比它必须的更具挑战性，但由于我最近没有使用 vba 或 excel，所以我以此为借口。请不要质疑方法论 :) 因为这只是我试图消除的一小步，以节省一些时间，直到我可以重做整个过程。我会做相反的事情，但这是他们正在使用的各种发票......

I'm thinking macro or function is what is needed and not a formula since the data on worksheet 2 will change each month and there is no date I can reference.

我认为宏或函数是需要的，而不是公式，因为工作表 2 上的数据每个月都会改变，并且没有我可以参考的日期。

What I'd like to do:

我想做什么：

I have a cell on worksheet 2 that will change once a month. I want to place the value of the cell from Worksheet 2 into a cell in worksheet 1 each month that she changes it.

我在工作表 2 上有一个单元格，每月更改一次。我想每个月将工作表 2 中的单元格值放入工作表 1 中的单元格中，她更改它。

Each month would be represented in column A and the value of the cell from Worksheet 2 during that month needs to be place in column B.

每个月都将在 A 列中表示，并且该月期间工作表 2 中单元格的值需要放在 B 列中。

Column A         Column B
12/5/2012        ,459,877.81 
1/8/2013         ,360,785.62 
2/8/2013        
3/8/2013        
4/8/2013        

So when she changes worksheet 1 for February the number will populate next to 2/8 and so on. I was thinking do it when she saves the document, or make it a shortcut she can hit or just scrap it and tell her it's not worth.

因此，当她更改 2 月份的工作表 1 时，该数字将填充在 2/8 旁边，依此类推。我想在她保存文档时这样做，或者让它成为她可以点击的快捷方式，或者只是废弃它并告诉她这不值得。

采纳答案by Tom 'Blue' Piddock

Giving a Cell a name to reference from you can do some neat stuff with the Target parameter passed to the Worksheet_Change function:

为 Cell 指定一个名称以供参考，您可以使用传递给 Worksheet_Change 函数的 Target 参数来做一些巧妙的事情：

'Add this function to the sheet that has the cell being
'+changed by the user (Sheet 2)
Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim strCellName As String
    strCellName = "ChangeMe"
    'If the cell we changed was the ChangeMeCell
    If Target.Address = Sheet2.Range(strCellName).Address Then
        'Store value
        Dim intLastRow, intValue As Integer
        intValue = Range(strCellName).Value

        'Find the cell in Sheet 1 Column A that matches this month
        intLastRow = Sheet1.Range("A:A").End(xlDown).Row
        For Each cl In Sheet1.Range("A1:A" & intLastRow).Cells
            'Ensure cell value is date
            If IsDate(cl.Value) Then

                'If date is today's date
                'Note that Math.Round(<date>, 0 ) essentially removes the time
                '+from any date value so #01/02/03 04:05:06# becomes #01/02/03#
                If Math.Round(cl.Value,0) = Math.Round(Now,0) Then
                    'Update column B's value
                    Sheet1.Range("B" & cl.Row).Value = intValue
                End If
            End If
        Next
    End If
End Sub

This assumes you have the sheet layout with the "invoice values" in Sheet1 and the cell being changed in Sheet2. You need to give that cell a name.

这假设您在 Sheet1 中具有带有“发票值”的工作表布局，并且在 Sheet2 中更改了单元格。您需要为该单元格命名。

Using the cell Name box to the left of the Function bar call the cell that changes "ChangeMe" or anything you wish to change it to, update that cell name in the first line of the function and this function will do all the rest.

使用功能栏左侧的单元格名称框调用更改“ChangeMe”或您希望将其更改为任何内容的单元格，在函数的第一行中更新该单元格名称，该函数将完成其余所有工作。

It is important to note that the dates must be correctly formatted for your systems region. to make sure it is showing the right month - format them into LongDate so you can see them as 08 March 2013 instead of 03/08/13 which may get confusing the longer it goes on. Speaking as a British programmer, dates are the bane of my life!

请务必注意，必须为您的系统区域正确设置日期格式。以确保它显示正确的月份 - 将它们格式化为 LongDate，以便您可以将它们视为 2013 年 3 月 8 日而不是 03/08/13，这可能会随着时间的推移而变得混乱。作为一名英国程序员，约会是我生命中的祸根！

Edit:I have update the code to compare the dates by the full date minus the time, instead of the previous monthly comparison, if you still need to subtract or add a month to either date value, just use the DateAdd("m", <date>, <value>)to add or subtract the month.

编辑：我更新了代码，通过完整日期减去时间来比较日期，而不是之前的每月比较，如果您仍然需要对任一日期值减去或添加一个月，只需使用DateAdd("m", <date>, <value>)添加或减去月份.

Edit:DatePart Function pageis a useful resource for those wanting to know more about DatePart()

编辑：DatePart 函数页面对于那些想要了解更多关于 DatePart() 的人来说是一个有用的资源

回答by techturtle

For my example, I'm using cell G4as the one that will be updated by your coworker. You have to have some way to persist the original value of G4in order to tell when it's been changed. The easy way to do this is to pick some cell that is out of sight of the user and store the number there so you can reference it later. Here I've chosen cell AA1. The following code must be added specifically to Sheet2since it needs to monitor the changed events on that sheet only so it can fire when G4is updated.

对于我的示例，我使用单元格G4作为将由您的同事更新的单元格。您必须有某种方法来保留的原始值，G4以便知道它何时被更改。做到这一点的简单方法是选择一些用户看不到的单元格并将数字存储在那里，以便您以后可以参考它。这里我选择了 cell AA1。必须专门添加以下代码，Sheet2因为它只需要监视该工作表上的更改事件，以便在G4更新时触发。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("G4") <> Range("AA1") Then
        Dim lastRow As Long

        Range("AA1") = Range("G4")
        lastRow = Worksheets("Sheet1").UsedRange.Rows.Count

        Worksheets("Sheet1").Cells(lastRow + 1, 1).Value = Date
        Worksheets("Sheet1").Cells(lastRow + 1, 2).Value = Range("AA1")

    End If
End Sub

Keep in mind that this is a very "quick and dirty" approach for this task, as there are no error handlers or much flexibility in the way it works.

请记住，对于此任务，这是一种非常“快速而肮脏”的方法，因为它的工作方式没有错误处理程序或很大的灵活性。

---

---

EDIT --

编辑 -

One other method you could use is referenced here, and can simply check to see if a given cell has changed, without verifying the difference in value.

此处引用了您可以使用的另一种方法，它可以简单地检查给定的单元格是否已更改，而无需验证值的差异。

 Private Sub Worksheet_Change(ByVal Target As Range)
     If Not Application.Intersect(Range("G4"), Range(Target.Address)) Is Nothing Then
        Dim lastRow As Long
        Range("AA1") = Range("G4")
         lastRow = Worksheets("Sheet1").UsedRange.Rows.Count

         Worksheets("Sheet1").Cells(lastRow + 1, 1).Value = Date
         Worksheets("Sheet1").Cells(lastRow + 1, 2).Value = Range("AA1")
     End If
 End Sub

回答by donviti

Now, I'm able to capture the value from a formula in the cell and place it in a different cell in another worksheet. Here's my final product:

现在，我可以从单元格中的公式中捕获值并将其放置在另一个工作表中的不同单元格中。这是我的最终产品：

Private Sub Worksheet_Calculate()

  Dim strCellName As String
   strCellName = "ChangeMe"
   If Sheets("Application of Moneys").Range(strCellName).Address <> PrevVal Then
    Dim intLastRow, intValue As Long
    intValue = Range(strCellName).Value

   'Find the cell in Sheet 1 Column A that matches this month
    intLastRow = Sheets("Certificate 1").Range("B:B").End(xlDown).Row
    For Each cl In Sheets("Certificate 1").Range("B13:B25" & intLastRow).Cells
        'Ensure cell value is date
        If IsDate(cl.Value) Then

            'If date is today's date
            'Note that Math.Round(<date>, 0 ) essentially removes the time
            '+from any date value so #01/02/03 04:05:06# becomes #01/02/03#
            If DatePart("m", cl.Value) = DatePart("m", Now()) Then
                'Update column B's value
                Sheets("Certificate 1").Range("H" & cl.Row).Value = intValue
            End If
        End If
    Next
End If
End Sub