VBAmacros代码列表名称

我有一个名单作为一列的Excel工作表，他们的工作时间作为下一列的值。

我想复制大于40的值的名称到新的表中，没有列中的空白。 新表应该有名字和工作时间; 值列中的任何文本都应该被忽略。

Sub CopyCells() Dim sh1 As Worksheet, sh2 As Worksheet Dim j As Long, i As Long, lastrow1 As Long Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") lastrow1 = sh1.Cells(Rows.Count, "F").End(xlUp).Row For i = 1 To lastrow1 If sh1.Cells(i, "F").Value > 20 Then sh2.Range("A" & i).Value = sh1.Cells(i, "F").Value End If Next i End Sub 

Answer 1

我会build议使用AutoFilter复制和粘贴，因为它比循环更快。 看下面的例子。

我的假设

1. 原始数据在Sheet 1中，如下面的快照所示
2. 您需要在Sheet 2中输出，如下面的快照所示

代码（TRIED AND TESTED）

我已经评论了代码，以便您不会理解它。

 Option Explicit Sub Sample() Dim wsI As Worksheet, wsO As Worksheet Dim lRow As Long '~~> Set the input sheet Set wsI = Sheets("Sheet1"): Set wsO = Sheets("Sheet2") '~~> Clear Sheet 2 for output wsO.Cells.ClearContents With wsI '~~> Remove any existing filter .AutoFilterMode = False '~~> Find last row in Sheet1 lRow = .Range("A" & .Rows.Count).End(xlUp).Row '~~> Filter Col B for values > 40 With .Range("A1:B" & lRow) .AutoFilter Field:=2, Criteria1:=">40" '~~> Copy the filtered range to Sheet2 .SpecialCells(xlCellTypeVisible).Copy wsO.Range("A1") End With '~~> Remove any existing filter .AutoFilterMode = False End With '~~> Inform user MsgBox "Done" End Sub 

快照

Answer 2

尝试rhis

 Sub CopyCells() Dim sh1 As Worksheet, sh2 As Worksheet Dim j As Long, i As Long, lastrow1 As Long Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") lastrow1 = sh1.Cells(Rows.Count, "F").End(xlUp).Row j = 1 For i = 1 To lastrow1 If Val(sh1.Cells(i, "F").Value) > 20 Then sh2.Range("A" & j).Value = sh1.Cells(i, "F").Value j = j + 1 End If Next i End Sub