Question

我有以下代码可以执行以下操作：

使用Dic比较两张纸，如果找到匹配，则将“DRG”（Col k）的值更新为“Latency”（进入Col O）。

这就是我想要做的，表格“DRG”中的Col K只能有3个值：

已批准
挂起
正在进行中

2.当找到匹配时，我想插入：“通过”为“已批准”，“失败”为“已批准”。

有人可以在这里指导我吗？

Sub PassFailValidation()

Dim cl As Range, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary"): Dic.Comparemode = vbTextCompare
With Sheets("Latency")
    For Each cl In .Range("B2:B" & .Cells(Rows.count, "C").End(xlUp).Row)
        If Not Dic.exists(cl.Value) Then Dic.Add cl.Value, cl.Row
    Next cl
End With

With Sheets("DRG")
    For Each cl In .Range("C2:C" & .Cells(Rows.count, "K").End(xlUp).Row) '
        If Dic.exists(cl.Value) Then
            Sheets("Latency").Cells(Dic(cl.Value), 15) = cl.Offset(, 1) '<--| write the values
            Dic.Remove (cl.Value)
        End If
    Next cl
End With
Set Dic = Nothing

End Sub

Answer 1

未测试：

Sub PassFailValidation()

    Dim cl As Range, Dic As Object
    Dim v, s

    Set Dic = CreateObject("Scripting.Dictionary"): Dic.Comparemode = vbTextCompare
    With Sheets("Latency")
        For Each cl In .Range("B2:B" & .Cells(Rows.count, "C").End(xlUp).Row)
            If Not Dic.exists(cl.Value) Then Dic.Add cl.Value, cl.Row
        Next cl
    End With

    With Sheets("DRG")
        For Each cl In .Range("C2:C" & .Cells(Rows.count, "K").End(xlUp).Row) 
            v = cl.Value
            If Dic.exists(v) Then
                Select Case cl.Offset(, 1).Value
                    Case "Approved": s = "Pass"
                    Case "Pended": s = "Fail"
                    Case Else: s = ""
                End If
                Sheets("Latency").Cells(Dic(v), 15) = s 
                Dic.Remove (v)
            End If
        Next cl
    End With
    Set Dic = Nothing

End Sub

Answer 2

我有点困惑，试图遵循你的一些逻辑而不能看到数据，但看到我测试和工作的下面的代码，希望如果我稍微误解了你想要做的事情，它是接近和清晰的你可以稍微调整它并使其正常工作......

Public Sub sampleCode()
Dim lookupRange As Range
Dim lookupArr() As Variant
Dim searchRange As Range
Dim rowCounter As Long
Dim matchResult As Variant

With ThisWorkbook.Sheets("Latency")
    Set lookupRange = .Range("B2:B" & .Range(.UsedRange.address)(.UsedRange.Rows.Count, 1).Row)
End With
lookupArr = lookupRange

With ThisWorkbook.Sheets("DRG")
    Set searchRange = .Range("C2:C" & .Range(.UsedRange.address)(.UsedRange.Rows.Count, 1).Row)
End With

For rowCounter = 1 To UBound(lookupArr, 1)
    Set searchResult = customFind(searchRange, lookupArr(rowCounter, 1))
    If TypeName(searchResult) = "Range" Then
        Select Case searchResult(1, 9).Text
            Case Is = "Approved"
                lookupRange(rowCounter, 14).Formula = "Pass"
            Case Is = "Pended"
                lookupRange(rowCounter, 14).Formula = "Fail"
        End Select
    End If
Next   
End Sub

Public Function customFind(searchRange As Range, lookupVal As Variant) As Variant
On Error GoTo fail:
Set customFind = searchRange.Find(lookupVal)
Exit Function
fail:
End Function

NB-你可以看到我将find函数移动到支持函数中 - 这是因为如果你问我，查找频繁返回错误并且主子中的VBA错误处理选项很弱，并且任何强大的EH都可能需要复制函数/子调用，所以我使用非常简单的支持函数，如上面的函数调用我的错误处理，没有惊喜.. 此外，如果你正在搜索大量的单元格并且速度正在成为一个问题，我会切换到所有阵列，但我没有在上面的例子中，因为对于大多数中小规模的情况来说它真的是过度杀伤。

希望这有帮助， TheSilkCode

Answer 3

使用Application.Match（已测试）：

尝试以下代码

Option Explicit

Sub PassFailValidation()

Dim Rng As Range, cl As Range
Dim LastRow As Long, MatchRow As Variant

With Sheets("DRG")
    LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row '<-- find last row with data in column C
    Set Rng = .Range("C2:C" & LastRow) '<-- set range in Column C
End With

With Sheets("Latency")
    For Each cl In .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row) ' loop through all cells in Column B
        MatchRow = Application.Match(cl.Value, Rng, 0) ' find match with values in Colummn C as in "DRG" sheet
        If Not IsError(MatchRow) Then ' <-- successful match

            Select Case Sheets("DRG").Range("K" & MatchRow + 1).Value
                Case "Approved"
                    .Range("O" & cl.Row).Value = "Pass"

                Case "Pended"
                    .Range("O" & cl.Row).Value = "Fail"

                Case "In progress"
                    .Range("O" & cl.Row).Value = "In progress"                
            End Select
        End If
    Next cl
End With

End Sub

使用vba转换文本并在目标表中更新

3 个答案: