VBA-Excel根据单元格值将数据导出到其他工作簿

亲爱的知识渊博的编码员,

我想从两个不同的Excel工作簿(阅读:心理testing)导入数据到不同的工作簿(数据库)中的单个工作表。 但是,在某些情况下,一个人需要多次testing,因此我不希望这些数据在数据库的第一个空白行中。 在这种情况下,我想用其他testing值将数据导入到现有的行中。

例如,我有一个数据库,具有以下列A(唯一标识符),B(智力值1),C(智力值2),D(人格testing)。 人1进行了智力测验和个性测验,这些结果存储在两个不同的excel文件中。 现在我想汇总数据库中的这些分数。 个性testing的结果已经input到数据库中,因此A列和D列已经填满了。 智能testingexcel文件中的代码因此需要在写入新行之前识别数据库中是否已经存在人1。 如果该人不存在,则必须创build新行。 没有这个查询的情报testing的代码看起来像下面的样子。

我可以想象它在If-Else命令的帮助下工作。 另外,我提供的代码需要包含引用该唯一标识符的单元格。 但是,我对此知之甚less,无法find合适的解决scheme。 你能帮我一个人吗?

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 

编辑

从两个虚拟文件附加的截图从所有的复杂性剥离。

智力表单(input)

概念数据库(输出)

这是否工作?

 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