将其他工作表中的计算值填充到新工作表中 [英] Populate calculated values from other sheets into new sheet

问题描述

我有一个excel，其中包含四张纸(例如sheet1，sheet2，sheet3和sheet4).我想填充计算值和其他信息，从(sheet1，sheet2，sheet3)到sheet4. sheet1，sheet2都包含ID，名称，年龄，金额，而sheet1是静态页面，而sheet2是动态页面. sheet3将具有ID，名称，年龄，贡献.输入所有这些值后，sheet4应该填充ID，姓名，年龄，总计(金额*贡献).

I have excel which contains four sheets (say sheet1, sheet2, sheet3 and sheet4). I want to populate calculated values and other information from (sheet1, sheet2, sheet3) to sheet4. Both sheet1, sheet2 contains ID,Name, Age, Amount whereas sheet1 is static page and sheet2 is dynamic page. sheet3 will have ID, Name, Age, Contribution. once all these values are entered sheet4 should populate ID, Name, Age, Total(Amount * Contribution).

第1页:

+--------------------------+
| ID | Name | Age | Amount |
+--------------------------+
| 1  | AAAA | 20  | 1500   |
+--------------------------+
| 2  | BBBB | 21  | 2000   |
+--------------------------+
| 3  | CCCC | 25  | 6000   |
+--------------------------+

第2页:

+--------------------------+
| ID | Name | Age | Amount |
+--------------------------+
| 4  | XXXY | 20  | 3000   |
+--------------------------+
| 7  | YYYY | 21  | 7000   |
+--------------------------+
| 9  | ZZZZ | 25  | 5000   |
+--------------------------+

第3页:

此工作表贡献值将由用户输入，他们从两个工作表(sheet1或sheet2)中为任何用户随机输入

This sheet contribution value will be entered by user and they randomly enter for any user from both of the sheets (sheet1 or sheet2)

+------------------------------+
| ID | Name | Age | Contribute |
+------------------------------+
| 1  | AAAA | 20  | 1          |
+------------------------------+
| 3  | CCCC | 25  | 8          |
+------------------------------+
| 7  | YYYY | 21  | 9          |
+------------------------------+
| 9  | ZZZZ | 25  | 10         |
+------------------------------+

第4页:

这应该是自动从Sheet3中自动填充ID，名称和年龄，并且值应为Amount * Contribution(基于ID，我来自sheet1或sheet2的金额)

This should be auto populate the ID, Name and Age from Sheet3 exactly and Values should be Amount * Contribution (Amount my come from sheet1 or sheet2 based on the ID)

+------------------------------+
| ID | Name | Age | Value      |
+------------------------------+
| 1  | AAAA | 20  | 1500       |
+------------------------------+
| 3  | CCCC | 25  | 48000      |
+------------------------------+
| 7  | YYYY | 21  | 63000      |
+------------------------------+
| 9  | ZZZZ | 25  | 50000      |
+------------------------------+

推荐答案

请尝试下一个代码.必须将其复制到虚拟"Sheet4"文件中.模块.

Try the next code, please. It must be copied in the dummy "Sheet4" module.

您必须替换"Sheet1 _"，"Sheet2 _"，"Sheet3_".工作表名称与您的真实姓名.还将清除所有记录以删除ID:

You must replace "Sheet1_", "Sheet2_", "Sheet3_" sheet names with your real ones. It will also clear all records for a deleted ID:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Column = 1 Then
        Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, IDCell As Range
        Dim dContrib As Double, dAmount As Double
        
        Set sh1 = Worksheets("Sheet1_"): Set sh2 = Worksheets("Sheet2_")
        Set sh3 = Worksheets("Sheet3_")
        
        Set IDCell = sh3.Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole)
        If Not IDCell Is Nothing Then
            If Target.Value <> "" Then
                Target.Offset(0, 1).Value = IDCell.Offset(0, 1).Value
                Target.Offset(0, 2).Value = IDCell.Offset(0, 2).Value
                If IsNumeric(IDCell.Offset(0, 3).Value) Then
                     dContrib = IDCell.Offset(0, 3).Value
                Else
                    'for the case of writing the ID header...
                    Target.Offset(0, 3).Value = "Value"
                    Exit Sub
                End If
            End If
        Else
            MsgBox """" & Target.Value & """ ID could not be found...": Target.Activate
            Exit Sub
        End If
        Set IDCell = sh1.Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole)
        If Not IDCell Is Nothing Then
            If Target.Value <> "" Then
                dAmount = IDCell.Offset(0, 3).Value
                Target.Offset(0, 3).Value = dAmount * dContrib: Exit Sub
            End If
        End If
         Set IDCell = sh2.Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole)
        If Not IDCell Is Nothing Then
            If Target.Value <> "" Then
                dAmount = IDCell.Offset(0, 3).Value
                Target.Offset(0, 3).Value = dAmount * dContrib: Exit Sub
            End If
        End If
        If Target.Value <> "" Then
            MsgBox """" & Target.Value & """ ID could not be found...": Target.Activate
        Else
            Target.Offset(0, 1).ClearContents: Target.Offset(0, 2).ClearContents
            Target.Offset(0, 3).ClearContents
        End If
   End If
End Sub

编辑后:

请使用下面的代码.将下一个代码粘贴到Sheet3中现有按钮的Click事件中:

Please, use the next code. Paste the next code in the Click event of your button existing on Sheet3:

Private Sub MyButton_Click()
    Dim sh1 As Worksheet, sh2 As Worksheet, sh As Worksheet, sh4 As Worksheet
    Dim dContrib As Double, dAmount As Double, IDCell As Range, Target As Range
    Dim lastRow As Long, rngCopy As Range, i As Long
        
    Set sh1 = Worksheets("Sheet1_"): Set sh2 = Worksheets("Sheet2_")
    Set sh = ActiveSheet: Set sh4 = Worksheets("Sheet4_")
        
    'Clear all the content of Sheet4, except its headers first row:
    sh4.Range("A2:D" & sh4.Range("A" & Rows.Count).End(xlUp).row).ClearContents
        
    'Copy all data from the first three columns of Sheet3:
    Set rngCopy = sh.Range("A2:C" & sh.Range("A" & Rows.Count).End(xlUp).row)
    sh4.Range("A2").Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
        
    'Iterate between all existing IDs and process the data:
    lastRow = sh4.Range("A" & Rows.Count).End(xlUp).row
    For i = 2 To lastRow
        Set Target = sh.Range("A" & i) 'ID to be processed
        dContrib = Target.Offset(0, 3).Value 'Amount
             
        Set IDCell = sh1.Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole)
        If Not IDCell Is Nothing Then
            If Target.Value <> "" Then
                dAmount = IDCell.Offset(0, 3).Value
                sh4.Range("D" & i).Value = dAmount * dContrib
            End If
        Else
            Set IDCell = sh2.Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole)
            If Not IDCell Is Nothing Then
                If Target.Value <> "" Then
                    dAmount = IDCell.Offset(0, 3).Value
                    sh4.Range("D" & i).Value = dAmount * dContrib
                End If
            End If
        End If
        Next i
        sh4.Activate 'activate the processed sheet, in order to see the result
End Sub

这篇关于将其他工作表中的计算值填充到新工作表中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！