1

ここでは「PriorityList」と呼ばれる1つのメインシートにコピーする必要のあるソースデータを含むいくつかのワークシートをループしようとしています。まず第一に、潜水艦は機能しておらず、エラーは「検索」メソッドのどこかにあると思います。第二に、潜水艦の実行にはかなり時間がかかります。これは、「検索」メソッドが関連する範囲だけでなくシート全体を検索するためだと思います。

ご回答ありがとうございます！

パトリック

Sub PriorityCheck()
'Sub module to actualise the PriorityList

Dim CurrWS As Long, StartWS As Long, EndWS As Long, ScheduleWS As Long
StartWS = Sheets("H_HS").Index
EndWS = Sheets("E_2").Index

Dim SourceCell As Range, Destcell As Range

For CurrWS = StartWS To EndWS

    For Each SourceCell In Worksheets(CurrWS).Range("G4:G73")

        On Error Resume Next

        'Use of the find method
        Set Destcell = Worksheets(CurrWS).Cells.Find(What:=SourceCell.Value, After:=Worksheets("PriorityList").Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

        'Copying relevant data from source sheet to main sheet
        If Destcell <> Nothing Then
            Destcell.Offset(0, 2).Value = SourceCell.Offset(0, 5).Value + Destcell.Offset(0, 2).Value
            If SourceCell.Offset(0, 3).Value = "x" Then Destcell.Offset(0, 3).Value = "x"
            End If
        End If

        On Error GoTo 0

    Next SourceCell

Next CurrWS

End Sub
4

3 に答える 3

3

ここでは、'Find' メソッドを使用して、priorityList 内の source.Value の最初の出現を見つける方法の短いサンプルを示します。

ソース セルは範囲"G4:G73"のセルの 1 つで、priorityListは"PriorityList"シートの範囲で使用されます。お役に立てれば。

Public Sub PriorityCheck()
    Dim source As Range
    Dim priorityList As Range
    Dim result As Range

    Set priorityList = Worksheets("PriorityList").UsedRange

    Dim i As Long
    For i = Worksheets("H_HS").Index To Worksheets("E_2").Index
        For Each source In Worksheets(i).Range("G4:G73")
            Set result = priorityList.Find(What:=source.Value)
            If (Not result Is Nothing) Then
                ' do stuff with result here ...
                Debug.Print result.Worksheet.Name & ", " & result.Address
            End If
        Next source
    Next i
End Sub
于 2013-02-17T20:45:29.460 に答える
2

これがを使用したアプローチarraysです。各範囲を配列に保存してから、配列を反復処理してif-else条件を満たすようにします。ところで、コードエラーのある正確な行を見つけたい場合は、行をコメント化する必要がありOn Error Resume Nextます。:)さらに、値を新しい配列に格納し、代わりにすべてのシートを繰り返し処理した後、他のすべてをメインシートにダンプすることができます。シート、コード、sheets..codeに行ったり来たりします。

Dim sourceArray as Variant, priorityArray as Variant
'-- specify the correct priority List range here
'-- if multi-column then use following method
priorityArray = Worksheets(CurrWS).Range("A1:B10").Value
'-- if single column use this method
' priorityArray = WorkSheetFunction.Transpose(Worksheets(CurrWS).Range("A1:A10").Value)

For CurrWS = StartWS To EndWS
   On Error Resume Next    
   sourceArray = Worksheets(CurrWS).Range("G4:J73").Value
   For i = Lbound(sourceArray,1) to UBound(sourceArray,1)
     For j = Lbound(priorityArray,1) to UBound(priorityArray,1)
        If Not IsEmpty(vArr(i,1)) Then    '-- use first column
        '-- do your validations here..
        '-- offset(0,3) refers to J column from G column, that means
        '---- sourceArray(i,3)...
        '-- you can either choose to update priority List sheet here or
        '---- you may copy data into a new array which is same size as priorityArray
        '------ as you deem..
        End If
     Next j
   Next i       
Next CurrWS

PS：これを試すためにMSExcelがインストールされたマシンの前ではありません。したがって、上記はテストされていないコードとして扱います。同じ理由で、findメソッドを実行できませんでした。しかし、それは奇妙に思えます。match使用するときは忘れないでください。そうでない場合findは、適切なエラー処理を行うことが重要です。findここで提供されている[ベースのソリューションをチェックしてみてください。

2つの配列を使用してメインロジックを含めるように初期コードを編集しました。ソースシートの列の値を参照するJ必要があるため、ソース配列を2次元配列に調整する必要があります。したがって、最初の列を使用して検証を実行してから、必要に応じてデータを取得できます。

于 2013-02-17T13:38:56.310 に答える
0

興味のある方のために、これは私が最終的に使用したコード バージョンです (Daniel Dusek によって提案されたバージョンとかなり似ています)。

Sub PriorityCheck()
    Dim Source As Range
    Dim PriorityList As Range
    Dim Dest As Range

    Set PriorityList = Worksheets("PriorityList").UsedRange

    Dim i As Long

    For i = Worksheets("H_HS").Index To Worksheets("S_14").Index
        For Each Source In Worksheets(i).Range("G4:G73")
        If Source <> "" Then
            Set Dest = PriorityList.Find(What:=Source.Value)
            If Not Dest Is Nothing Then
                If Dest <> "" Then
                    Dest.Offset(0, 2).ClearContents
                    Dest.Offset(0, 2).Value = Source.Offset(0, 5).Value + Dest.Offset(0, 2).Value
                End If
            If Source.Offset(0, 3).Value = "x" Then Dest.Offset(0, 3).Value = "x"
                Debug.Print Dest.Worksheet.Name & ", " & Dest.Address
            End If
        End If
        Next Source
    Next i

    MsgBox "Update Priority List completed!"

End Sub
于 2013-02-19T14:13:15.290 に答える