DeepSeek合并Excel数据

liufangshun

已于 2025-02-13 14:53:12 修改

阅读量373

点赞数 4

分类专栏： AI 文章标签： excel AI-native AI编程

于 2025-02-13 14:47:43 首次发布

本文链接：https://blog.youkuaiyun.com/liufangshun/article/details/145610815

版权

AI 专栏收录该内容

16 篇文章

订阅专栏

问：有一个excel表格，有两个表单分别是语文成绩和数学成绩，每个表从第一列起依次是学号、姓名、成绩，请帮我写一段VBA，把以上两个表中成绩合成到第三个表中，要求相同学号、姓名的同学信息合成一行。

DeepSeek:
你可以使用以下VBA代码将“语文成绩”和“数学成绩”两个表单中的成绩合并到第三个表单中。假设第三个表单名为“合并成绩”，代码会将相同学号和姓名的学生信息合并到一行。

Sub MergeScores()
    Dim wsChinese As Worksheet
    Dim wsMath As Worksheet
    Dim wsMerged As Worksheet
    Dim lastRowChinese As Long
    Dim lastRowMath As Long
    Dim lastRowMerged As Long
    Dim i As Long, j As Long
    Dim studentId As String
    Dim studentName As String
    Dim chineseScore As Variant
    Dim mathScore As Variant
    Dim found As Boolean
    
    ' 设置工作表
    Set wsChinese = ThisWorkbook.Sheets("语文成绩")
    Set wsMath = ThisWorkbook.Sheets("数学成绩")
    Set wsMerged = ThisWorkbook.Sheets("合并成绩")
    
    ' 获取语文成绩表的最后一行
    lastRowChinese = wsChinese.Cells(wsChinese.Rows.Count, 1).End(xlUp).Row
    ' 获取数学成绩表的最后一行
    lastRowMath = wsMath.Cells(wsMath.Rows.Count, 1).End(xlUp).Row
    
    ' 清空合并表的内容
    wsMerged.Cells.Clear
    
    ' 添加表头
    wsMerged.Cells(1, 1).Value = "学号"
    wsMerged.Cells(1, 2).Value = "姓名"
    wsMerged.Cells(1, 3).Value = "语文成绩"
    wsMerged.Cells(1, 4).Value = "数学成绩"
    
    ' 初始化合并表的行数
    lastRowMerged = 1
    
    ' 遍历语文成绩表
    For i = 2 To lastRowChinese
        studentId = wsChinese.Cells(i, 1).Value
        studentName = wsChinese.Cells(i, 2).Value
        chineseScore = wsChinese.Cells(i, 3).Value
        
        ' 在合并表中查找是否已有该学生的记录
        found = False
        For j = 2 To lastRowMerged
            If wsMerged.Cells(j, 1).Value = studentId And wsMerged.Cells(j, 2).Value = studentName Then
                wsMerged.Cells(j, 3).Value = chineseScore
                found = True
                Exit For
            End If
        Next j
        
        ' 如果没有找到，则添加新行
        If Not found Then
            lastRowMerged = lastRowMerged + 1
            wsMerged.Cells(lastRowMerged, 1).Value = studentId
            wsMerged.Cells(lastRowMerged, 2).Value = studentName
            wsMerged.Cells(lastRowMerged, 3).Value = chineseScore
        End If
    Next i
    
    ' 遍历数学成绩表
    For i = 2 To lastRowMath
        studentId = wsMath.Cells(i, 1).Value
        studentName = wsMath.Cells(i, 2).Value
        mathScore = wsMath.Cells(i, 3).Value
        
        ' 在合并表中查找是否已有该学生的记录
        found = False
        For j = 2 To lastRowMerged
            If wsMerged.Cells(j, 1).Value = studentId And wsMerged.Cells(j, 2).Value = studentName Then
                wsMerged.Cells(j, 4).Value = mathScore
                found = True
                Exit For
            End If
        Next j
        
        ' 如果没有找到，则添加新行
        If Not found Then
            lastRowMerged = lastRowMerged + 1
            wsMerged.Cells(lastRowMerged, 1).Value = studentId
            wsMerged.Cells(lastRowMerged, 2).Value = studentName
            wsMerged.Cells(lastRowMerged, 4).Value = mathScore
        End If
    Next i
    
    ' 自动调整列宽
    wsMerged.Columns.AutoFit
    
    MsgBox "成绩合并完成！"
End Sub

代码说明：

工作表设置：代码首先设置了三个工作表对象 wsChinese、wsMath 和 wsMerged，分别对应“语文成绩”、“数学成绩”和“合并成绩”三个表单。
获取最后一行：通过 End(xlUp) 方法获取“语文成绩”和“数学成绩”表的最后一行。
清空合并表：在合并之前，清空“合并成绩”表的内容。
添加表头：在“合并成绩”表中添加表头。
遍历语文成绩表：遍历“语文成绩”表中的每一行，将学号、姓名和语文成绩插入到“合并成绩”表中。如果学号和姓名已经存在，则只更新语文成绩。
遍历数学成绩表：遍历“数学成绩”表中的每一行，将学号、姓名和数学成绩插入到“合并成绩”表中。如果学号和姓名已经存在，则只更新数学成绩。
自动调整列宽：合并完成后，自动调整“合并成绩”表的列宽。

使用方法：

打开Excel文件，按 Alt + F11 打开VBA编辑器。
在VBA编辑器中，插入一个新模块（Insert > Module）。
将上述代码粘贴到模块中。
关闭VBA编辑器，返回Excel。
按 Alt + F8，选择 MergeScores 宏并运行。

运行后，“合并成绩”表中将包含所有学生的学号、姓名、语文成绩和数学成绩。

问：成绩合并后，按学号从低到高排序

DeepSeek:

在合并成绩后，你可以通过VBA代码对“合并成绩”表按学号从低到高进行排序。以下是修改后的代码，添加了排序功能：

Sub MergeAndSortScores()
    Dim wsChinese As Worksheet
    Dim wsMath As Worksheet
    Dim wsMerged As Worksheet
    Dim lastRowChinese As Long
    Dim lastRowMath As Long
    Dim lastRowMerged As Long
    Dim i As Long, j As Long
    Dim studentId As String
    Dim studentName As String
    Dim chineseScore As Variant
    Dim mathScore As Variant
    Dim found As Boolean
    
    ' 设置工作表
    Set wsChinese = ThisWorkbook.Sheets("语文成绩")
    Set wsMath = ThisWorkbook.Sheets("数学成绩")
    Set wsMerged = ThisWorkbook.Sheets("合并成绩")
    
    ' 获取语文成绩表的最后一行
    lastRowChinese = wsChinese.Cells(wsChinese.Rows.Count, 1).End(xlUp).Row
    ' 获取数学成绩表的最后一行
    lastRowMath = wsMath.Cells(wsMath.Rows.Count, 1).End(xlUp).Row
    
    ' 清空合并表的内容
    wsMerged.Cells.Clear
    
    ' 添加表头
    wsMerged.Cells(1, 1).Value = "学号"
    wsMerged.Cells(1, 2).Value = "姓名"
    wsMerged.Cells(1, 3).Value = "语文成绩"
    wsMerged.Cells(1, 4).Value = "数学成绩"
    
    ' 初始化合并表的行数
    lastRowMerged = 1
    
    ' 遍历语文成绩表
    For i = 2 To lastRowChinese
        studentId = wsChinese.Cells(i, 1).Value
        studentName = wsChinese.Cells(i, 2).Value
        chineseScore = wsChinese.Cells(i, 3).Value
        
        ' 在合并表中查找是否已有该学生的记录
        found = False
        For j = 2 To lastRowMerged
            If wsMerged.Cells(j, 1).Value = studentId And wsMerged.Cells(j, 2).Value = studentName Then
                wsMerged.Cells(j, 3).Value = chineseScore
                found = True
                Exit For
            End If
        Next j
        
        ' 如果没有找到，则添加新行
        If Not found Then
            lastRowMerged = lastRowMerged + 1
            wsMerged.Cells(lastRowMerged, 1).Value = studentId
            wsMerged.Cells(lastRowMerged, 2).Value = studentName
            wsMerged.Cells(lastRowMerged, 3).Value = chineseScore
        End If
    Next i
    
    ' 遍历数学成绩表
    For i = 2 To lastRowMath
        studentId = wsMath.Cells(i, 1).Value
        studentName = wsMath.Cells(i, 2).Value
        mathScore = wsMath.Cells(i, 3).Value
        
        ' 在合并表中查找是否已有该学生的记录
        found = False
        For j = 2 To lastRowMerged
            If wsMerged.Cells(j, 1).Value = studentId And wsMerged.Cells(j, 2).Value = studentName Then
                wsMerged.Cells(j, 4).Value = mathScore
                found = True
                Exit For
            End If
        Next j
        
        ' 如果没有找到，则添加新行
        If Not found Then
            lastRowMerged = lastRowMerged + 1
            wsMerged.Cells(lastRowMerged, 1).Value = studentId
            wsMerged.Cells(lastRowMerged, 2).Value = studentName
            wsMerged.Cells(lastRowMerged, 4).Value = mathScore
        End If
    Next i
    
    ' 按学号从低到高排序
    With wsMerged
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("A2:A" & lastRowMerged), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SetRange .Range("A1:D" & lastRowMerged)
        .Sort.Header = xlYes
        .Sort.Apply
    End With
    
    ' 自动调整列宽
    wsMerged.Columns.AutoFit
    
    MsgBox "成绩合并并排序完成！"
End Sub

新增的排序功能说明：

排序范围：使用 With wsMerged 语句指定排序范围为“合并成绩”表的 A1:D 到最后一行的区域。
排序字段：通过 .Sort.SortFields.Add 方法添加排序字段，按“学号”列（A列）进行升序排序。
排序设置：
- Key：指定排序的列（A列）。
- Order：设置为 xlAscending，表示升序排序。
- Header：设置为 xlYes，表示包含表头。
应用排序：通过 .Sort.Apply 方法应用排序。