0

単一の行と列からの情報に基づいて、特定のセルを赤くしようとしています。私のアルゴリズムが行うことになっているのは、単一の列を検索して一致する文字列を見つけ、その列番号を保存してから、行に対して同じことを行うことです。次に、スクリプトはセルを選択し、赤にします。

私が検索するすべてのキーは、オンラインで見つけたコードを自分のニーズに合わせて変更したものです。それは完全に機能します。問題は、検索が正しく機能しないことです。

Option Explicit


Sub Blahbot()

Dim xRow As Long
Dim x As Long, y As Long
Dim xDirect$, xFname$, InitialFoldr$, xFF$

InitialFoldr$ = "G:\" '<<< Startup folder to begin searching from

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = Application.DefaultFilePath & "\"
    .Title = "Please select a folder to list Files from"
    .InitialFileName = InitialFoldr$
    .Show
    If .SelectedItems.Count <> 0 Then
        xDirect$ = .SelectedItems(1) & "\"
        xFname$ = Dir(xDirect$, 7) '<<< Where the search terms come from
        Do While xFname$ <> ""
            y = Application.WorksheetFunction.Match(Mid(xFname$, 11, 4), Range("D2:KD2"), 0) '<<< Find a matching string in table header
            x = Application.WorksheetFunction.Match(Mid(xFname$, 16, 4), Range("B3:B141"), 0) '<<< Find matching string in column B
            Cells(x, y).Select '<<<Select the cell and turn it red
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 255
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            xFname$ = Dir
        Loop
    End If
End With
End Sub

このコードが行うことは、フォルダー全体を読み取り、ファイル名を取得して、それらを分割することです。名前は常に @@@@_#### (@=大文字、#### は 24 時間形式の時刻) です。

Mid 関数は、その名前を 4 文字と時間に分割します。

私がやろうとしていることを理解している場合は、より良い検索アルゴリズムを提案するか、私のコードが間違っているかを確認できますか?

4

1 に答える 1

1

あなたの質問を誤解している可能性があるため、回答を簡略化しました。検索する範囲に相対的なMATCH値を返します。したがって、一致が列 D にある場合は 1 を返します。したがって、返された値をオフセットする必要があります。MATCH

'Add 2 to x, since we start on 3rd row, add 3 to y since we start on 4th column
Cells(x+2, y+3).Select

一致がないかどうかを確認するコードを含めることもできます。この問題が発生しているかどうかを確認するには、以下のコードを使用してこれをテストするか、ウォッチを追加します。

On Error Resume Next
y = Application.WorksheetFunction.Match(...)
If Err = 0 Then
    MsgBox "All is well"
Else
    MsgBox "There was an error with Match"
End If
On Error Goto 0
于 2012-07-30T14:49:20.980 に答える