编写vba代码实现数据录入工作

Question

写vba代码实现如下功能：
1.代码1：每次打开考核表，在原始数据中输入对应信息后将信息写到对应的sheet中。比如：根据“原始数据”中姓名“张三”找到“张三”sheet，然后根据考核项后面的信息找到“张三”sheet中对应单元格把次数项后面的数值填写进去（如图）。2.代码2：同时在对应工作表最下方生成每个sheet中的数据汇总。包含：sheet名称、考核项、各考核项次数、各考核项总分值、总分值。（如图）

Answer 1

以下内容由AIGC及阿里嘎多学长共同生成、有用望采纳：

---

要实现你的需求，我们需要编写两个VBA宏。以下是实现这两个功能的VBA代码示例：

代码1：自动将原始数据填入对应Sheet

Sub AutoFillData()
    Dim wsOriginal As Worksheet
    Dim wsTarget As Worksheet
    Dim rngData As Range
    Dim cell As Range
    Dim lastRow As Long
    Dim name As String
    Dim criteria As String
    Dim targetRow As Long

    ' 设置原始数据工作表
    Set wsOriginal = ThisWorkbook.Sheets("原始数据")
    
    ' 找到原始数据的最后一行
    lastRow = wsOriginal.Cells(wsOriginal.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历原始数据中的每个姓名
    For i = 2 To lastRow
        name = wsOriginal.Cells(i, 1).Value ' 假设姓名在第一列
        
        ' 根据姓名找到对应的工作表
        On Error Resume Next ' 忽略找不到工作表的错误
        Set wsTarget = ThisWorkbook.Sheets(name)
        On Error GoTo 0
        
        ' 如果找到了对应的工作表
        If Not wsTarget Is Nothing Then
            ' 找到考核项对应的列
            criteria = wsOriginal.Cells(i, 2).Value ' 假设考核项在第二列
            
            ' 找到考核项的列号
            For Each cell In wsTarget.Rows(1).Cells
                If cell.Value = criteria Then
                    Exit For
                End If
            Next cell
            
            ' 确定要填写数据的行号
            targetRow = cell.Column + i - 2
            
            ' 将次数写入对应的单元格
            wsTarget.Cells(targetRow, cell.Column + 1).Value = wsOriginal.Cells(i, 3).Value ' 假设次数在第三列
        End If
    Next i
End Sub

代码2：在每个Sheet的最下方生成数据汇总

Sub GenerateSummary()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim summaryRow As Long
    Dim summaryColumn As Long
    Dim cell As Range
    Dim summaryData() As Variant
    Dim i As Long

    ' 遍历所有工作表
    For Each ws In ThisWorkbook.Sheets
        ' 忽略原始数据工作表
        If ws.Name <> "原始数据" Then
            ' 找到数据的最后一行和最后一列
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            lastColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            
            ' 准备汇总数据数组
            ReDim summaryData(1 To 5, 1 To lastColumn)
            
            ' 填充汇总数据数组
            For i = 1 To lastColumn
                summaryData(1, i) = ws.Name ' Sheet名称
                summaryData(2, i) = ws.Cells(1, i).Value ' 考核项
                summaryData(3, i) = Application.WorksheetFunction.CountIf(ws.Columns(i), ">0") ' 各考核项次数
                summaryData(4, i) = Application.WorksheetFunction.Sum(ws.Columns(i)) * 10 ' 各考核项总分值，假设每项分值为10
                summaryData(5, i) = summaryData(4, i) ' 总分值
            Next i
            
            ' 找到汇总数据的起始行和列
            summaryRow = lastRow + 2
            summaryColumn = 1
            
            ' 写入汇总数据
            For i = 1 To UBound(summaryData, 1)
                ws.Cells(summaryRow, summaryColumn).Resize(1, UBound(summaryData, 2)).Value = summaryData(i,)
                summaryRow = summaryRow + 1
            Next i
        End If
    Next ws
End Sub

请注意，这些代码示例是基于你提供的描述和图片内容编写的。你可能需要根据实际的Excel文件结构调整代码中的一些细节，比如列号、行号和特定的值。在实际使用之前，请确保在Excel的VBA编辑器中测试这些宏，并根据需要进行调整。