Question

我试图根据单行和列的信息将某些单元格变为红色。我的算法应该做的是搜索单列并找到匹配的字符串并保存列号，然后对该行执行相同操作。然后脚本选择单元格并将其变为红色。

我搜索的所有密钥都来自我在网上找到的一段代码，并根据我的需要进行了修改。它完美地运作。问题是我无法使搜索正常工作。

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个字母和时间。

如果您了解我正在尝试做什么，您能否提出更好的搜索算法或查看我的代码出错？

Answer 1

我简化了我的答案，因为我可能误解了你的问题。 MATCH会将值 relative 返回到您查看的范围。因此，如果匹配位于D列，则MATCH将返回1.因此，您需要抵消返回值。

'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

根据表头和单个列更改单元格值

1 个答案: