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

編輯

從兩個虛擬文件附加的屏幕截圖從所有復雜性剝離。

情報形式（輸入）

概念數據庫（輸出）

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