0 
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim wks As Worksheet
On Error GoTo Err_Execute


For Each wks In Worksheets
    ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
    Set wksCopyTo = ActiveSheet
    wks.Rows(3).EntireRow.Copy wksCopyTo.Rows(3)

    'Start search in row 4
    LSearchRow = 4
    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 4

    While Len(wks.Range("A" & CStr(LSearchRow)).Value) > 0
        'If value in column E = "Mail Box", copy entire row to Sheet2
        If wks.Range("AB" & CStr(LSearchRow)).Value = "Yes" And wks.Range("AK" & CStr(LSearchRow)).Value = "Yes" And wks.Range("BB" & CStr(LSearchRow)).Value = "Y" Then
            'Select row in Sheet1 to copy
            wks.Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy
            MsgBox "Copying Row"
            'Paste row into Sheet2 in next row
            wksCopyTo.Select
            wksCopyTo.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            wksCopyTo.Paste
            MsgBox "Pasting Row"
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
            'Go back to Sheet1 to continue searching
            wks.Select
        End If
        LSearchRow = LSearchRow + 1
    Wend

    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select
    MsgBox "All matching data has been copied."
Next wks

Exit Sub
Err_Execute:
    MsgBox "An error occurred."

やあ

私は他の場所で与えられたコードに基づいた上記のコードを持っています。コードは、if ステートメントで指定された基準を満たす行をコピーするときに、既存のワークシートごとに新しいワークシートを作成する必要がある場所に適応されています。私が抱えている問題は次のとおりです。

  1. Excel では、コードを実行する前に存在するすべてのワークシートを最初に見つけて、ループを回避できますか?
  2. 1 つのワークシートで作業しているときに指定したコードが、しばらくすると実行されません。その理由がわかりません。
  3. 1 つのワークシートで実行すると、32,000 行後にクラッシュします

誰でも助けることができますか？

4

1 に答える 1

0

私はあなたの質問に一つずつ答えます：

  1. はい。ThisWorkbook.Worksheets.Count現在のワークブックにあるワークシートの数を返すようなものを使用できます。ただし、ワークシートをループする最善の方法は、Worksheetsコレクションを反復処理することです。

    Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
    'Do something
    '...
Next wks

Set wks = Nothing

  2. もちろん、オーバーフロー エラーが発生するまで (整数は 32,767 +/- にしか移動できません)、ループを終了することはありません (列 A に 32,000 行を超えるデータがある場合)。

  3. ポイント2を参照してください。整数の制限を超えてループしています。データ型を Long に変更するか、ポイント 2 で述べたように、ある時点でループを終了します。

于 2012-05-11T14:55:54.593 に答える