0

名前が 1 つの列で、作業時間が次の列の値である 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
4

2 に答える 2

5

AutoFilterループよりも高速なコピー アンド ペーストを使用することをお勧めします。以下の例を参照してください。

私の仮定

  1. 以下のスナップショットに示すように、元のデータはシート 1 にあります。
  2. 以下のスナップショットに示すように、シート 2 に出力が必要です。

コード

コードを理解するのに問題がないように、コードにコメントを付けました。

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

スナップショット

ここに画像の説明を入力

于 2012-08-16T10:26:23.970 に答える
1

リスを試す

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
于 2012-08-16T10:24:49.843 に答える