如何修改VBA代码：仅转移延迟学生的指定列数据至新工作表

Got it, let's tweak your VBA code to only transfer the specific columns for students who meet the delay criteria. Here's a tailored solution with explanations:

Modified VBA Code #

Sub TransferDelayedStudents()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRowSource As Long
    Dim lastRowTarget As Long
    Dim i As Long
    Dim studentType As String
    Dim enrollPeriod As Integer
    
    ' 👇 Replace with your actual worksheet names
    Set wsSource = ThisWorkbook.Worksheets("SourceSheet")
    Set wsTarget = ThisWorkbook.Worksheets("DelayedStudents")
    
    ' Optional: Copy header row to target sheet (remove if you don't need headers)
    With wsTarget
        .Range("A1").Value = wsSource.Range("A1").Value ' Original A → Target A
        .Range("B1").Value = wsSource.Range("B1").Value ' Original B → Target B
        .Range("C1").Value = wsSource.Range("D1").Value ' Original D → Target C
        .Range("D1").Value = wsSource.Range("G1").Value ' Original G → Target D
        .Range("E1").Value = wsSource.Range("H1").Value ' Original H → Target E
        .Range("F1").Value = wsSource.Range("I1").Value ' Original I → Target F
        .Range("G1").Value = wsSource.Range("M1").Value ' Original M → Target G
    End With
    
    ' Get last row with data in source sheet
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    ' Start pasting data from row 2 (since header is in row 1)
    lastRowTarget = 2
    
    ' Loop through each data row in source sheet (skip header row 1)
    For i = 2 To lastRowSource
        ' 👇 Replace these column references with your actual data columns
        studentType = wsSource.Cells(i, "C").Value ' Assume student type is in column C
        enrollPeriod = wsSource.Cells(i, "J").Value ' Assume enroll-period is in column J
        
        ' Check delay criteria based on student type
        Select Case UCase(studentType)
            Case "硕士", "MASTER" ' Add/remove text matches as needed (case-insensitive)
                If enrollPeriod <= 132 Then
                    ' Copy specified columns to target sheet
                    wsTarget.Cells(lastRowTarget, "A").Value = wsSource.Cells(i, "A").Value
                    wsTarget.Cells(lastRowTarget, "B").Value = wsSource.Cells(i, "B").Value
                    wsTarget.Cells(lastRowTarget, "C").Value = wsSource.Cells(i, "D").Value
                    wsTarget.Cells(lastRowTarget, "D").Value = wsSource.Cells(i, "G").Value
                    wsTarget.Cells(lastRowTarget, "E").Value = wsSource.Cells(i, "H").Value
                    wsTarget.Cells(lastRowTarget, "F").Value = wsSource.Cells(i, "I").Value
                    wsTarget.Cells(lastRowTarget, "G").Value = wsSource.Cells(i, "M").Value
                    lastRowTarget = lastRowTarget + 1 ' Move to next empty row in target
                End If
            Case "学士", "BACHELOR"
                If enrollPeriod <= 130 Then
                    ' Same column mapping for undergraduate students
                    wsTarget.Cells(lastRowTarget, "A").Value = wsSource.Cells(i, "A").Value
                    wsTarget.Cells(lastRowTarget, "B").Value = wsSource.Cells(i, "B").Value
                    wsTarget.Cells(lastRowTarget, "C").Value = wsSource.Cells(i, "D").Value
                    wsTarget.Cells(lastRowTarget, "D").Value = wsSource.Cells(i, "G").Value
                    wsTarget.Cells(lastRowTarget, "E").Value = wsSource.Cells(i, "H").Value
                    wsTarget.Cells(lastRowTarget, "F").Value = wsSource.Cells(i, "I").Value
                    wsTarget.Cells(lastRowTarget, "G").Value = wsSource.Cells(i, "M").Value
                    lastRowTarget = lastRowTarget + 1
                End If
        End Select
    Next i
    
    ' Confirmation message with count of transferred records
    MsgBox "Transfer complete! " & lastRowTarget - 2 & " delayed student records moved.", vbInformation
End Sub

Key Customizations You Need to Make #

• Worksheet Names: Update SourceSheet and DelayedStudents to match your actual sheet names in the workbook.
• Data Columns: Replace the column references for studentType (e.g., "C") and enrollPeriod (e.g., "J") with the columns where this data is stored in your source sheet.
• Student Type Text: Adjust the text in the Case statements (like "硕士" or "MASTER") to match exactly how student types are written in your data (the UCase() function makes this case-insensitive, so "硕士" and "硕士" will both work).
• Header Copy: If you don't need to copy headers to the target sheet, delete the entire With wsTarget ... End With block.

Optional Performance Tip #

If you're working with a large dataset, add these lines to speed up the code:

' Add at the very start of the sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' Add right before the MsgBox
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

内容的提问来源于stack exchange，提问作者Chris TJ