*进一步向下更新* VBA:用VLookup值替换单元格列及其相邻单元格

时间:2017-09-13 09:47:52

标签: excel vba excel-vba

以下是我目前的代码:

Sub Worksheet_Name_Change()

Dim ws As Worksheet
Dim FindWhat As String, ReplaceWith As String
Dim dataCells As Range
Dim regEx As New RegExp
Dim strPattern As String: strPattern = "^[0-9]+[-A-Z]*[-0-9]+$"

With regEx
    .Global = True
    .MultiLine = True
    .IgnoreCase = False
    .Pattern = strPattern
End With

FindWhat = Worksheets("Add").Range("B4")
If FindWhat = "False" Then Exit Sub  ' Replacing this with regex matching later

ReplaceWith = Worksheets("Add").Range("D4")
If ReplaceWith = "False" Then Exit Sub  ' Replacing this with regex matching later

On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = Worksheets("Add").Name Then Exit For
    ws.Cells.Replace What:=FindWhat, Replacement:=ReplaceWith, LookAt:= _
    xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Next ws
On Error GoTo 0

MsgBox "Done!", vbInformation, "Update"

End Sub

Sub VLTEST()
Worksheets("Add").Range("B6") = Application.WorksheetFunction.VLookup("Tom", Worksheets("Test Table").Range("C4:D7"), 2, True)
End Sub

我要做的是当我替换工作表中的值时,我还用另一个表中的VLookup将单元格替换为右边。

所以我要替换值的表格(称为“数据”)是这样的:

  A        B
-------------------
Timmy   Is cool 
Andy    Is ok   
Paul    Is enemy No.1   
Timmy   Is cool 
Andy    Is ok   
Paul    Is enemy No.1   
Timmy   Is cool 
Andy    Is ok   
Paul    Is enemy No.1   
Timmy   Is cool 
Andy    Is ok   
Paul    Is enemy No.1   

我的第二张(称为“测试表”)有下表

Name    Att.
-------------------
Timmy   Is cool
Andy    Is ok
Paul    Is enemy No.1 
Greg    Goes here

我的另一张表(称为“添加”)的表单如下所示:

Old Code        New Code
------------------------
Timmy           Greg         BUTTON

当用户按下按钮时,它会在第一张表格中将“Timmy”替换为“Greg”:

  A        B
-------------------
Greg    Is cool
Andy    Is ok
Paul    Is enemy No.1 
Greg    Is cool
Andy    Is ok
Paul    Is enemy No.1 
Greg    Is cool
Andy    Is ok
Paul    Is enemy No.1 
Greg    Is cool
Andy    Is ok
Paul    Is enemy No.1 

但我想要做的是弄清楚如何将相邻的单元格引用到被替换的那些并实现我的VLTest函数基本上VLookup“Greg”的Att。在“测试表”表格的表格中,最后得到:

  A        B
-------------------
Greg    Goes here
Andy    Is ok
Paul    Is enemy No.1 
Greg    Goes here
Andy    Is ok
Paul    Is enemy No.1
Greg    Goes here
Andy    Is ok
Paul    Is enemy No.1
Greg    Goes here
Andy    Is ok
Paul    Is enemy No.1

我觉得我没有随处可见。有人可以帮忙吗?

  

更新:Mrigs回答

Mrigs的回答对我有用,我很高兴得到它,但我现在只有一个问题

将测试表格作为:

enter image description here

我改变了:

cel.Offset(0, 1).Value = "Goes Here"    'replace adjacent value

要:

cel.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(testWS.Range("B1").Value, Worksheets("Test Table").Range("A1:B5"), 2, True)    'replace adjacent value

但它似乎没有找到正确的值

e.g

Application.WorksheetFunction.VLookup("Timmy", Worksheets("Test Table").Range("A1:B5"), 2, True)

返回:“去这里” - 应该是“很酷”

Application.WorksheetFunction.VLookup("Greg", Worksheets("Test Table").Range("A1:B5"), 2, True)

返回:“很热” - 应该是“Goes here”

Application.WorksheetFunction.VLookup("Phil", Worksheets("Test Table").Range("A1:B5"), 2, True)

返回:“是是否” - 正确

Application.WorksheetFunction.VLookup("Andy", Worksheets("Test Table").Range("A1:B5"), 2, True)

返回:“很热” - 正确

为什么第一行和最后一行返回错误的行?

1 个答案:

答案 0 :(得分:2)

假设表Data如下

enter image description here

和工作表Test Table

enter image description here

以下可能有所帮助

Sub Worksheet_Name_Change()
    Dim dataWS As Worksheet, testWS As Worksheet
    Dim srcRng As Range, cel As Range

    Set dataWS = ThisWorkbook.Sheets("Data")
    Set testWS = ThisWorkbook.Sheets("Test Table")

    With dataWS
        Set srcRng = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, 1))    'set range in column A
    End With

    For Each cel In srcRng    'loop through each cell in Column A
        If cel.Value = testWS.Range("A2").Value Then    'check is value is to be replaced
            cel.Value = testWS.Range("B2").Value    'replace the value
            cel.Offset(0, 1).Value = "Goes here"    'replace adjacent value
        End If
    Next cel
End Sub

我假设您要在替换值旁边显示Goes here

输出

enter image description here