Question

我有以下代码，如果学生被推迟，将学生转到另一张表。如果硕士生的入学时间为132或以下，而学士学生的入学时间为130或更低，则学生会被推迟。如果学生被延迟，此代码将复制所有标题并将所有列和数据转移到新表格中。我只需要来自A，B，D，G，H，I，M列的数据，并将其放在A，B，C，D，E，F，G列的新表中，如果学生被延迟的话。我应该如何更改此代码，以便它可以做到这一点？提前致谢！

Sub findDelayedStudents()

Dim wsIn As Worksheet
Dim wsOut As Worksheet


Set wsIn = ThisWorkbook.Worksheets("Base")
Set wsOut = ThisWorkbook.Worksheets("Delayed Students")


wsOut.Cells.ClearContents
wsIn.Rows(1).Copy Destination:=wsOut.Range("A1")

Dim lLastInputRow As Long
Dim lCurrentInputRow As Long
Dim lCurrentOutputRow As Long


lLastInputRow = wsIn.Cells(wsIn.Rows.Count, 1).End(xlUp).Row
lCurrentOutputRow = 2


For lCurrentInputRow = lLastInputRow To 2 Step -1

If (wsIn.Cells(lCurrentInputRow, 10) = "B" And wsIn.Cells(lCurrentInputRow, 
5).Value <= 130) Or _
    (wsIn.Cells(lCurrentInputRow, 10) = "M" And wsIn.Cells(lCurrentInputRow, 
5).Value <= 132) Then


    wsIn.Rows(lCurrentInputRow).Copy 
Destination:=wsOut.Cells(lCurrentOutputRow, 1)
    lCurrentOutputRow = lCurrentOutputRow + 1
End If
Next lCurrentInputRow

wsIn.Range("A1").Select
Set wsIn = Nothing
Set wsOut = Nothing

End Sub

Answer 1

目前，您使用代码的这一部分中的inbuild复制粘贴方法复制整行：

wsIn.Rows(lCurrentInputRow).Copy 
Destination:=wsOut.Cells(lCurrentOutputRow, 1)
lCurrentOutputRow = lCurrentOutputRow + 1

最简单的方法就是通过细胞方式复制你的值，如：

wsOut.Cells(lCurrentOutputRow,1) = wsIn.Cells(lCurrentInputRow,1) 'A to A
wsOut.Cells(lCurrentOutputRow,2) = wsIn.Cells(lCurrentInputRow,2) 'B to B
wsOut.Cells(lCurrentOutputRow,3) = wsIn.Cells(lCurrentInputRow,4) 'D to C
wsOut.Cells(lCurrentOutputRow,4) = wsIn.Cells(lCurrentInputRow,7) 'G to D
wsOut.Cells(lCurrentOutputRow,5) = wsIn.Cells(lCurrentInputRow,8) 'H to E
wsOut.Cells(lCurrentOutputRow,6) = wsIn.Cells(lCurrentInputRow,9) 'I to F
wsOut.Cells(lCurrentOutputRow,7) = wsIn.Cells(lCurrentInputRow,13) 'M to G
lCurrentOutputRow = lCurrentOutputRow + 1

要设置正确的标题，请替换代码的这一部分：

wsIn.Rows(1).Copy Destination:=wsOut.Range("A1")

使用：

wsOut.Cells(1,1) = wsIn.Cells(1,1) 'A to A
wsOut.Cells(1,2) = wsIn.Cells(1,2) 'B to B
wsOut.Cells(1,3) = wsIn.Cells(1,4) 'D to C
wsOut.Cells(1,4) = wsIn.Cells(1,7) 'G to D
wsOut.Cells(1,5) = wsIn.Cells(1,8) 'H to E
wsOut.Cells(1,6) = wsIn.Cells(1,9) 'I to F
wsOut.Cells(1,7) = wsIn.Cells(1,13) 'M to G

VBA，将特定列传输到新工作表

1 个答案: