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

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

1 个答案: