VBA数组字典循环赋值

Question

想把sheet1里没有日期的从sheet2里匹配过来，原表有上万行，就想用数组和字典循环，但是写的代码一步一步看过程都可以，但是最后结果却不对，不知道哪里错了

Answer 1

引自免费微信小程序：皆我百晓生

针对你提出的问题，即在VBA中使用字典和数组将Sheet2中的入学日期匹配到Sheet1中相应学生的信息上，下面是一种可能的解决方案。此方案旨在修复你提供的代码中存在的问题，并确保正确地更新Sheet1中缺失的入学日期。

解决方案

首先，我们需要确保Sheet2中的数据可以被Sheet1正确引用，特别是当涉及到姓名与入学日期的匹配时。接下来是经过修改的VBA代码示例，它应该能解决你的问题：

Sub MatchEnrollmentDates()
    Application.ScreenUpdating = False
    
    ' 创建字典对象用于存储姓名和入学日期
    Dim myDict As Object
    Set myDict = CreateObject("Scripting.Dictionary")
    
    ' 取得Sheet2的引用
    Dim sheet2 As Worksheet
    Set sheet2 = Workbooks(2).Sheets("Sheet2")
    
    ' 取得Sheet1的引用
    Dim sheet1 As Worksheet
    Set sheet1 = Workbooks(2).Sheets("Sheet1")
    
    ' 确定Sheet2的最大行数
    Dim maxRowSheet2 As Long
    maxRowSheet2 = sheet2.Cells(sheet2.Rows.Count, 1).End(xlUp).Row
    
    ' 遍历Sheet2，填充字典
    For i = 2 To maxRowSheet2
        myDict.Add sheet2.Cells(i, 1).Value, sheet2.Cells(i, 3).Value
    Next i
    
    ' 确定Sheet1的最大行数
    Dim maxRowSheet1 As Long
    maxRowSheet1 = sheet1.Cells(sheet1.Rows.Count, 1).End(xlUp).Row
    
    ' 遍历Sheet1，更新入学日期
    For i = 2 To maxRowSheet1
        ' 检查当前单元格是否为空
        If IsEmpty(sheet1.Cells(i, 3).Value) Then
            ' 使用字典查找入学日期
            If myDict.exists(sheet1.Cells(i, 2).Value) Then
                sheet1.Cells(i, 3).Value = myDict.Item(sheet1.Cells(i, 2).Value)
            End If
        End If
    Next i
    
    Application.ScreenUpdating = True
End Sub

解释

1. 字典初始化：创建一个字典对象myDict来存储Sheet2中学生的姓名和入学日期。
2. 读取Sheet2：遍历Sheet2的所有行，将姓名作为键，入学日期作为值存入字典。
3. 读取Sheet1：遍历Sheet1的所有行，检查每个学生的入学日期是否为空。
4. 更新入学日期：如果入学日期为空，从字典中查找对应学生的入学日期并更新到Sheet1中。

注意事项

• 确保姓名列和入学日期列在两个工作表中都是正确的。
• 此代码假设姓名是唯一的，即没有同名的学生。如果有重复姓名，可能需要额外的逻辑来区分不同的学生。

通过以上步骤，你应该能够正确地从Sheet2中匹配并更新Sheet1中缺失的入学日期信息。