使用vba转换文本并在目标工作表中更新
我有以下代码可以执行以下操作：
- 使用Dic比较两个工作表，如果find匹配，则将工作表“DRG”（Col k）的值更新到工作表“Latency”（到Col O）中。
这是我想要做的，Col K在表格“DRG”中只能有3个值：
- 批准
- 挂起
- 进行中
2.如果find一个匹配，而不是插入上述三个值，我想要插入：“通过”为“批准”，“失败”为“悬挂”。
有人可以在这里指导我吗？
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 尝试下面的代码使用Application.Match （testing）：
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
未经testing：
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
我有点困惑，试图按照你的一些逻辑，而不能看到数据，但看到下面的代码，我testing和工作，希望如果我误解了你想做的事情，这是足够接近和清晰，足以让你能够稍微调整它，并让它工作…
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函数移到了一个支持函数中 – 这是因为Find经常返回错误，如果你问我，主Sub中的VBAerror handling选项是弱的，而且任何强健的EHing都可能需要重复函数/ sub调用，所以我使用非常简单的支持function，如上所述，以一个函数调用我的error handling，并没有惊喜..此外，如果您search的数量非常大的单元格和速度成为一个问题，我会切换到所有数组，但我没有在上面的例子中，因为这对大多数中小规模的情况来说确实是过度的。
希望这有助于TheSilkCode