VBA-Excel Экспорт данных в другую книгу на основе значения ячейки

Уважаемые знающие кодеры,

Я хотел бы импортировать данные из двух разных книг 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 

редактировать

Прикрепленные скриншоты из двух фиктивных файлов лишены всей сложности.

Интеллектуальная форма (ввод)

База данных концепций (выход)

Это работает?

 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 
Давайте будем гением компьютера.