4

シート 1 の最初の列の値が 10 以上の場合、シート 1 からシート 2 に行をコピーするスクリプトを作成しようとしています。

Sub Macro1()

Cells(1, 1).Select
For i = 1 To ActiveCell.SpecialCells(xlLastCell).Row

    Cells(i, 1).Select

    If ActiveCell.Value >= 10 Then
        Rows(ActiveCell.Row).Select

        Rows(i & ":").Select
        Selection.Copy

        Sheets("Sheet2").Select
        ActiveSheet.Paste

        Sheets("Sheet1").Select

     End If

Next i

End Sub
4

3 に答える 3

6

これは最初の回答と似ていますが、いくつかの違いがあります。ここにいくつかのメモがあります：

  • for-each ループを使用して範囲を通過します (バリアント配列を使用するほど高速ではありませんが、物事をシンプルに保ち、for ループよりも高速です。
  • 値チェックの前に「If IsNumeric(cell)」チェックを追加することができます。
  • select を使用しないでください - 必要がなく、リソースを浪費します。
  • 使用された範囲よりも、A で使用された最後のセルを使用することをお勧めします。

コードは次のとおりです。

Sub CopyRows()

Dim cell As Range
Dim lastRow As Long, i As Long

lastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 1

For Each cell In Sheets(1).Range("A1:A" & lastRow)
    If cell.Value >= 10 Then
        cell.EntireRow.Copy Sheets(2).Cells(i, 1)
        i = i + 1
    End If
Next

End Sub
于 2012-05-09T06:59:49.187 に答える
3

これを試してください：選択に依存せず、VBAを介したデータの直接操作に依存するため、最速になります

Sub CopyRows()
    Dim r_src As Range, r_dst As Range

    ' Pick 1st row and column of table
    Set r_src = Sheets("Sheet1").Range("B4")
    Set r_dst = Sheets("Sheet2").Range("B4")

    Dim i As Integer, j As Integer
    Dim N_rows As Integer, N_cols As Integer

    'Find the size of the data
    N_rows = CountRows(r_src)
    N_cols = CountColumns(r_src)

    'Resize source range to entire table
    Set r_src = r_src.Resize(N_rows, N_cols)

    Dim src_vals() As Variant, dst_vals() As Variant
    'Get all the values from source
    src_vals = r_src.Value2

    ReDim dst_vals(1 To N_rows, 1 To N_cols)
    Dim k As Integer
    k = 0
    For i = 1 To N_rows
        ' Check first column
        If Val(src_vals(i, 1)) >= 10 Then
            ' Increment count
            k = k + 1
            ' Copy row values
            For j = 1 To N_cols
                dst_vals(k, j) = src_vals(i, j)
            Next j
        End If
    Next i
    ' Bring rows back into destination range
    If k > 0 Then
        r_dst.Resize(k, N_cols).Value2 = dst_vals
    End If
End Sub

Public Function CountRows(ByRef r As Range) As Integer
    CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End Function
Public Function CountColumns(ByRef r As Range) As Integer
    CountColumns = r.Worksheet.Range(r.End(xlToRight), r).Columns.Count
End Function

これが私が実行するテストケースです：

前

Sheet1

後

Sheet2

于 2012-05-08T20:28:12.340 に答える
1

これはあなたがしようとしていることですか？

Option Explicit

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim LastRow As Long, i As Long, j As Long

    Set wsI = Sheets("Sheet1")
    Set wsO = Sheets("Sheet2")

    LastRow = wsI.Range("A" & Rows.Count).End(xlUp).Row

    j = 1

    With wsI
        For i = 1 To LastRow
            If Val(Trim(.Range("A" & i).Value)) >= 10 Then
                wsI.Rows(i).Copy wsO.Rows(j)
                j = j + 1
            End If
        Next i
    End With
End Sub
于 2012-05-08T16:33:48.407 に答える