VBA-Excel 根据单元格值将数据导出到另一个工作簿

Question

亲爱的知识渊博的程序员，

我想将两个不同 Excel 工作簿（阅读：心理测试）中的数据导入不同工作簿（数据库）中的单个工作表。但是，在某些情况下，一个人需要进行多次测试，因此我不希望该数据位于数据库的第一个空白行中。在那种情况下，我想将数据导入到具有其他测试值的现有行中。

例如，我有一个数据库，其中包含以下列 A（唯一标识符）、B（智力值 1）、C（智力值 2）、D（性格测试）。第 1 个人进行了智力测试和性格测试，这些结果存储在两个不同的 Excel 文件中。现在我想在数据库中汇总这些分数。性格测试的结果已经导入数据库，因此 A 和 D 列已经填满。因此，智能测试 excel 文件中的代码需要在写入新行之前识别数据库中是否已经存在人员 1。如果此人不存在，则必须创建一个新行。没有此查找的智力测试代码如下所示。

我可以想象它在 If-Else 命令的帮助下工作。此外，我提供的代码需要包含一个引用该唯一标识符的单元格。但是，我对此知之甚少，无法找到合适的解决方案。你们中的哪一位可以帮帮我吗？

Private Sub CommandButton1_Click()
Dim Intelligence1 As String
Dim Intelligence2 As String
Dim mydata As Workbook

Worksheets("Scores").Select
Intelligence1 = Range("D3")
Intelligence2 = Range("D4")

Set mydata = Workbooks.Open("C:\Users\Tim\Desktop\Database-Concept.xlsx")
Worksheets("aggregate").Select
Worksheets("aggregate").Unprotect Password:="1234"
Worksheets("aggregate").Range("a1").Select
RowCount = Worksheets("aggregate").Range("a1").CurrentRegion.Rows.Count

With Worksheets("aggregate").Range("A1")
.Offset(RowCount, 1) = Intelligence1
.Offset(RowCount, 2) = Intelligence2
End With

Worksheets("aggregate").Protect Password:="1234"
mydata.Save

End Sub

编辑

附加了两个虚拟文件的屏幕截图，消除了所有复杂性。

Intelligence form (input)

Concept database (output)

Answer 1

这行得通吗？

Private Sub CommandButton1_Click()
Dim Intelligence1 As String
Dim Intelligence2 As String
Dim mydata As Workbook
Dim RangeFoundID As Range
Dim RowCount As Long
Worksheets("Scores").Select
Intelligence1 = Range("D3")
Intelligence2 = Range("D4")

Set mydata = Workbooks.Open("C:\Users\Tim\Desktop\Database-Concept.xlsx")
Worksheets("aggregate").Select
Worksheets("aggregate").Unprotect Password:="1234"
Worksheets("aggregate").Range("a1").Select


'If the cell is constant like in the image
'note however, if there's a duplicated record it won't be fixed and will only update the first of them.
Set RangeFoundID = Columns(1).Find(Cells(2, 3).Value, LookAt:=xlWhole)

If RangeFoundID Is Nothing Then ' 1. If RangeFoundID Is Nothing
RowCount = Worksheets("aggregate").Cells.SpecialCells(xlCellTypeLastCell).Row + 1
'My suggestion above goes to the last real row, what happens if you let a whole row blank? It would count less than really are RowCount = Worksheets("aggregate").Range("a1").CurrentRegion.Rows.Count
With Worksheets("aggregate")
.Cells(RowCount, 1).Value = Cells(2, 3).Value
.Cells(RowCount, 2).Value = Intelligence1
.Cells(RowCount, 3) = Intelligence2
End With

Else ' 1. If RangeFoundID Is Nothing

With Worksheets("aggregate").Range(RangeFoundID.Address)
.Offset(RowCount, 1) = Intelligence1
.Offset(RowCount, 2) = Intelligence2
End With
End If ' 1. If RangeFoundID Is Nothing


Worksheets("aggregate").Protect Password:="1234"
mydata.Save

End Sub