1

私は VBA を初めて使用し、このコードをより簡単かつ効率的に記述する方法が必要であることは知っていますが、正しい機能 (既存のデータを貼り付けずに次のワークシートに貼り付ける方法など) に慣れていません。小さいワークシートでは機能しますが、60000 行以上のワークシートで使用する必要があります。どんな助けでも大歓迎です。前もって感謝します。

Sub test()
    Dim row As Long
    With Excel.Application
        .ScreenUpdating = False
        .Calculation = Excel.xlCalculationManual
        .EnableEvents = False
    End With

For row = 1 To 65500
If ThisWorkbook.ActiveSheet.Cells(row, 14) <> "" Then
    ThisWorkbook.ActiveSheet.Cells(row, 1).EntireRow.Copy
    ThisWorkbook.ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row, 1)
    ThisWorkbook.ActiveSheet.Cells(row + 1, 1).EntireRow.Copy
    ThisWorkbook.ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row + 1, 1)

End If

Next

For row = 1 To 65500
If ThisWorkbook.Sheets("SCO").Cells(row, 14) = "" Then
    ThisWorkbook.Sheets("SCO").Cells(row, 20).Value = 2
End If
Next
For x = 65500 To 1 Step -1
    If ThisWorkbook.Sheets("SCO").Cells(x, 3) = "" Then
    ThisWorkbook.Sheets("SCO").Cells(x, 1).EntireRow.Delete
End If
Next
For row = 1 To 65500
If ThisWorkbook.Sheets("SCO").Cells(row, 20) = 2 Then
    ThisWorkbook.Sheets("SCO").Cells(row + 1, 1).EntireRow.Insert shift:=xlDown
End If

Next

With Excel.Application
    .ScreenUpdating = True
    .Calculation = Excel.xlAutomatic
    .EnableEvents = True
End With

End Sub
4

1 に答える 1

1

ActiveSheet.UsedRange.Copyオートフィルターを使用して必要なデータをフィルター処理し、フィルター処理されたデータを新しいシートにコピーするために使用することをお勧めします。また、65500 まで行くのではなく、すべてのデータをループする必要がある場合はActiveSheet.UsedRange.Rows.Count、空のセルをループしないようにします。

例：

最初のループは、列 14 に空白がないすべての行をコピーするように見えます。

For row = 1 To 65500
    If ThisWorkbook.ActiveSheet.Cells(row, 14) <> "" Then
        ActiveSheet.Cells(row, 1).EntireRow.Copy
        ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row, 1)
        ActiveSheet.Cells(row + 1, 1).EntireRow.Copy
        ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row + 1, 1)
    End If
Next

すべてのデータをループする代わりに、次のようにフィルターして結果をコピーできます。

'Filter out blank rows in column 14
ActiveSheet.UsedRange.AutoFilter Field:=14, Criteria1:="<>"

'Copy and Paste the results to Sheet "SCO"
If Sheets("SCO").Range("A1").Value = "" Then
    ActiveSheet.UsedRange.Copy Destination:=Sheets("SCO").Range("A1")
Else
    ActiveSheet.UsedRange.Copy Destination:=Sheets("SCO").Cells(Sheets("SCO").UsedRange.Rows.Count, 1)
End If

ここでも 1 から 65500 までループします

For row = 1 To 65500
    If Sheets("SCO").Cells(row, 14) = "" Then
        Sheets("SCO").Cells(row, 20).Value = 2
    End If
Next

これを行うと、ループに必要な回数を減らすことができます

For row = 1 To Sheets("SCO").UsedRange.Rows.Count
    If Sheets("SCO").Cells(row, 14) = "" Then
        Sheets("SCO").Cells(row, 20).Value = 2
    End If
Next
于 2013-06-14T14:55:22.230 に答える