问题
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).
Sheet 1:
+--------------------------+
| ID | Name | Age | Amount |
+--------------------------+
| 1 | AAAA | 20 | 1500 |
+--------------------------+
| 2 | BBBB | 21 | 2000 |
+--------------------------+
| 3 | CCCC | 25 | 6000 |
+--------------------------+
Sheet 2:
+--------------------------+
| ID | Name | Age | Amount |
+--------------------------+
| 4 | XXXY | 20 | 3000 |
+--------------------------+
| 7 | YYYY | 21 | 7000 |
+--------------------------+
| 9 | ZZZZ | 25 | 5000 |
+--------------------------+
Sheet 3:
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 |
+------------------------------+
Sheet 4:
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 |
+------------------------------+
回答1:
Try the next code, please. It must be copied in the dummy "Sheet4" module.
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
After edit:
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
回答2:
You dont require sheet 4 to do this.
Sheet1: Keep entire table in sheet 1
Sheet2: Enter id and use formula [=vlookup(A1,A1:D10,2,0)] in name field where you want value of name. Here 2 refers to column no. of sheet 1. This way you can use formulae is all cells. Whenever you change id, remaining fields will be auto populated.
来源：https://stackoverflow.com/questions/62575410/populate-calculated-values-from-other-sheets-into-new-sheet