使用vlookup在列中找到匹配的值 [英] using vlookup to find matching values in a column
本文介绍了使用vlookup在列中找到匹配的值的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
此示例为
AB
1 Anna | 23岁
2 Anna | 34岁以上
所以B1中的值应该自动34岁，因为A列中的值匹配
我该怎么做？
解决方案
Sub Demo（）
Dim dict1 As Object
Dim c1 As Variant
Dim i As Long，lastRow As Long
Dim strFound As Range
Dim strFirst As String，copyVal As String
设置dict1 = CreateObject（Scripting.Dictionary）
lastRow = Cells（Rows.Count，A）。End（xlUp）.Row' - >获取列A中的数据的最后一行
'输入dict1中的列A的唯一值
c1 =范围（A1：A& lastRow）
对于i = 1到UBound（c1，1）
dict1（c1（i，1））= 1
下一步i
对于每个k在dict1.keys
'查找dict1中的每个值的最后一次
设置rngFound =列（A）。Find（k，Cells（Rows .Count，A），xlValues，xlWhole，，x l前一个）
如果没有rngFound是没有，然后
'获取列B值找到的字符串
copyVal = rngFound.Offset（0，1）.Value
strFirst = rngFound.Address
Do
'找到dict1中的每个值的所有出现
设置rngFound =列（A）。Find（k，rngFound，xlValues，xlWhole，，xlPrevious）
'在每个出现的列B中更改值
rngFound.Offset（0，1）.Value = copyVal
循环while rngFound.Address<> strFirst
结束如果
下一个k
结束子
查看图片供参考：
编辑＃ 1
________________________________________________________________________________
Sub Demo（）
应用程序.ScreenUpdating = False
Dim dict1 As Object，dict2 As Object
Dim c1 As Variant
Dim i As Long，lastRow As Long
Dim strFound As Range，delRange As Range
Dim strFirst As String，copyVal As String
设置dict1 = CreateObject（Scripting.Dictionary）
设置dict2 = CreateObject（Scripting.Dictionary）
lastRow = Cells（Rows.Count，A）。End（xlUp）.Row' - >获取列A中的数据的最后一行
'输入唯一值dict1中的列A
c1 =范围（A1：A& lastRow）
对于i = 1对于UBound（c1，1）
dict1（c1（i，1））= 1
下一个i
对于每个k In dict1.keys
'找到dict1中每个值的最后一次，并在dict2中保存行号
设置rngFound =列（A）。Find（k，xlValues，xlWhole，，xlPrevious）
如果不是rngFound是没有，然后
dict2.add rngFound.Row，1
结束如果
下一个k
'检查列A如果行号存在dict2，如果没有，则添加到删除的范围
对于i = 1 To lastRow
如果不是dict2.exists（Cells（i，1）.Row）然后
Debug.Print Cells（我，1）.Address
如果delRange不是，然后
设置delRange = Cells（i，1）
Else
设置delRange = Union（delRange，Cells（i，1） ）
结束如果
结束如果
下一个i
'删除范围
如果没有delRange是没有
delRange.EntireRow.Delete
End If
Application.ScreenUpdating = True
End Sub
编辑＃2
________________________________________________________________________________
Sub Demo（）
Application.ScreenUpdating = False
Dim dict1 As Object， dict2 As Object
Dim c1 As Variant
Dim i As Long，lastRow As Long
Dim strFound As Range，delRange As Range
Dim rngFound As Range，rngFound1 As Range
Dim strFirst As String，copyVal As String
设置dict1 = CreateObject（Scripting.Dictionary）
设置dict2 = CreateObject（Scripting.Dictionary）
lastRow = Cells（Rows.Count，B）。End（xlUp）.Row' - >使用da获取最后一行列A中的ta
'输入dict1中的列A的唯一值
c1 = Range（B1：B& lastRow）
对于i = 1对于UBound（c1，1）
dict1（c1（i，1））= 1
下一个i
对于每个k In dict1.keys
'找到dict1中的每个值的第一个出现
设置rngFound =列（B）。Find（k，xlValues，xlWhole）
'查找每个值的最后一次在dict1
设置rngFound1 =列（B）。Find（k，xlValues，xlWhole，，xlPrevious）
如果rngFound.Address<> rngFound1.Address然后
rngFound.Offset（0，1）= rngFound1.Offset（0，1）
rngFound.Offset（0,2）= rngFound1.Offset（0,2）
如果delRange没有，那么
设置delRange = rngFound1
Else
设置delRange = Union（delRange，rngFound1）
如果
结束If
下一个k
'删除范围
如果不是delRange是没有
delRange.EntireRow.Delete
结束如果
Application.ScreenUpdating = True
结束Sub
I have a column A with duplicate values inside it. I want to write a vlookup which does the following; If A has duplicate value inside it, the B value of this columns same row should be overwritten to previous A values same row in Column B.
An example for this ;
A B
1 Anna | 23 years old
2 Anna | 34 years old
So the value in B1 should be automatically 34 years old since the values in A column match.
How can i do this?
解决方案
Try this:
Sub Demo()
Dim dict1 As Object
Dim c1 As Variant
Dim i As Long, lastRow As Long
Dim strFound As Range
Dim strFirst As String, copyVal As String
Set dict1 = CreateObject("Scripting.Dictionary")
lastRow = Cells(Rows.Count, "A").End(xlUp).Row '-->get last row with data in column A
'enter unique values of column A in dict1
c1 = Range("A1:A" & lastRow)
For i = 1 To UBound(c1, 1)
dict1(c1(i, 1)) = 1
Next i
For Each k In dict1.keys
'find last occurrence of each value in dict1
Set rngFound = Columns("A").Find(k, Cells(Rows.Count, "A"), xlValues, xlWhole, , xlPrevious)
If Not rngFound Is Nothing Then
'get column B value for found string
copyVal = rngFound.Offset(0, 1).Value
strFirst = rngFound.Address
Do
'find all the occurrences of each value in dict1
Set rngFound = Columns("A").Find(k, rngFound, xlValues, xlWhole, , xlPrevious)
'change value in column B for each occurrence
rngFound.Offset(0, 1).Value = copyVal
Loop While rngFound.Address <> strFirst
End If
Next k
End Sub
See image for reference:
EDIT# 1 ________________________________________________________________________________
Sub Demo()
Application.ScreenUpdating = False
Dim dict1 As Object, dict2 As Object
Dim c1 As Variant
Dim i As Long, lastRow As Long
Dim strFound As Range, delRange As Range
Dim strFirst As String, copyVal As String
Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")
lastRow = Cells(Rows.Count, "A").End(xlUp).Row '-->get last row with data in column A
'enter unique values of column A in dict1
c1 = Range("A1:A" & lastRow)
For i = 1 To UBound(c1, 1)
dict1(c1(i, 1)) = 1
Next i
For Each k In dict1.keys
'find last occurrence of each value in dict1 and save row number in dict2
Set rngFound = Columns("A").Find(k, , xlValues, xlWhole, , xlPrevious)
If Not rngFound Is Nothing Then
dict2.add rngFound.Row, 1
End If
Next k
'check for column A if row number exists in dict2, if not then add to a range for deletion
For i = 1 To lastRow
If Not dict2.exists(Cells(i, 1).Row) Then
Debug.Print Cells(i, 1).Address
If delRange Is Nothing Then
Set delRange = Cells(i, 1)
Else
Set delRange = Union(delRange, Cells(i, 1))
End If
End If
Next i
'delete the range
If Not delRange Is Nothing Then
delRange.EntireRow.Delete
End If
Application.ScreenUpdating = True
End Sub
EDIT# 2 ________________________________________________________________________________
Sub Demo()
Application.ScreenUpdating = False
Dim dict1 As Object, dict2 As Object
Dim c1 As Variant
Dim i As Long, lastRow As Long
Dim strFound As Range, delRange As Range
Dim rngFound As Range, rngFound1 As Range
Dim strFirst As String, copyVal As String
Set dict1 = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")
lastRow = Cells(Rows.Count, "B").End(xlUp).Row '-->get last row with data in column A
'enter unique values of column A in dict1
c1 = Range("B1:B" & lastRow)
For i = 1 To UBound(c1, 1)
dict1(c1(i, 1)) = 1
Next i
For Each k In dict1.keys
'find first occurrence of each value in dict1
Set rngFound = Columns("B").Find(k, , xlValues, xlWhole)
'find last occurrence of each value in dict1
Set rngFound1 = Columns("B").Find(k, , xlValues, xlWhole, , xlPrevious)
If rngFound.Address <> rngFound1.Address Then
rngFound.Offset(0, 1) = rngFound1.Offset(0, 1)
rngFound.Offset(0, 2) = rngFound1.Offset(0, 2)
If delRange Is Nothing Then
Set delRange = rngFound1
Else
Set delRange = Union(delRange, rngFound1)
End If
End If
Next k
'delete the range
If Not delRange Is Nothing Then
delRange.EntireRow.Delete
End If
Application.ScreenUpdating = True
End Sub
这篇关于使用vlookup在列中找到匹配的值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
