时间戳

首页 > 解决方案 > 比较列和传输数据

excel - 比较列和传输数据

问题描述

我正在比较两张纸和它们的列。我的代码运行。问题是它比较了大多数值并留下了一些值，尽管它们是相同的。

Sub Peformance()
Dim k As Integer
Dim i As Integer
Dim j As Integer
For i = 1 To 138
    If (ActiveWorkbook.Worksheets("report").Cells(i, 6).Value = "course-1") Then
        For j = 1 To 138
            If (ActiveWorkbook.Worksheets("report").Cells(i, 1).Value = Cells(j, 1)) Then
                Cells(j, 4).Value = (ActiveWorkbook.Worksheets("report").Cells(i, 12).Value) / 100
                Cells(j, 5).Value = (ActiveWorkbook.Worksheets("report").Cells(i, 20).Value) / 100
                Cells(j, 6).Value = (ActiveWorkbook.Worksheets("report").Cells(i, 13).Value)
            End If
        Next j
    End If
Next i

For k = 1 To 138
    If (IsEmpty(Cells(k, 4).Value)) Then
        Cells(k, 4).Value = 0
        Cells(k, 5).Value = 0
    End If
    If (IsEmpty(Cells(k, 6).Value)) Then
        Cells(k, 6).Value = 0
    End If



End Sub

在一个文件（表 2）中，我有课程 1、课程 2、课程 3 等学生课程。
在另一个文件（表 1）中，我有学生姓名。

在比较名称（sheet-2 和 sheet-1 的 Column-1）之后，我必须将性能从 sheet-2 复制到 sheet-1。

它运行但不显示一些名字相同的学生的输出。
另外如何添加区分大小写的功能？

样本数据

表2：

姓名 电子邮件 外部的 课程 课程编号 课程-蛞蝓 工作百分比
一个 a@gmail.com 12 一个 课程 课程一 63%
乙 b@gmail.com 13 一个 课程 课程一 19%

表 1：

姓名 工作百分比
一个
乙

所以 sheet1 列 Work-Percentage 将在比较 sheet-2 中的名称和 course-Slug 后从 Work-Percentage 列中复制数据

标签： excelvba

解决方案

双倍...下一个

  • 调整目标工作表 ( dws) 的名称，因为我将其命名Course-1。
  • StrComp正在处理区分大小写的问题。
  • 这只是您学习（理解）的快速解决方案。否则，效率可以大大提高。
  • 未测试。

编码

Option Explicit

Sub Peformance()
    
    ' Constants
    Const sFirstRow As Long = 2
    Const dFirstRow As Long = 2
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets("Report")
    Dim sLastRow As Long: sLastRow = sws.Cells(sws.Rows.Count, 1).End(xlUp).Row
    Dim k As Long
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets("Course-1")
    Dim dLastRow As Long: dLastRow = dws.Cells(dws.Rows.Count, 1).End(xlUp).Row
    Dim i As Long
    
    ' Loop
    For i = dFirstRow To dLastRow
        For k = sFirstRow To sLastRow
            If StrComp(sws.Cells(k, 6).Value, "course-1", vbTextCompare) = 0 _
                    And StrComp(dws.Cells(i, 1).Value, sws.Cells(k, 1).Value, _
                    vbTextCompare) = 0 Then
                ' Student was found in Source Worksheet.
                dws.Cells(i, 4).Value = sws.Cells(k, 12).Value / 100
                dws.Cells(i, 5).Value = sws.Cells(k, 20).Value / 100
                dws.Cells(i, 6).Value = sws.Cells(k, 13).Value
                Exit For ' Student was found, no need to loop any longer.
            End If
        Next k
        If k > sLastRow Then
            ' Student wasn't found in Source Worksheet.
            If IsEmpty(dws.Cells(i, 4)) Then
                If IsEmpty(dws.Cells(i, 6)) Then
                    dws.Cells(i, 4).Resize(3).Value = 0
                Else
                    dws.Cells(i, 4).Resize(2).Value = 0
                End If
            End If
        End If
    Next i

End Sub

推荐阅读