Excel VBA宏:遍历一页上的值以检查另一页上的匹配项并分配值 [英] Excel VBA Macro: Iterating over values on one page to check for match on another page and assign value

问题描述

我要做什么:遍历一页上的值以检查另一页上的匹配项，如果找到匹配项，则从第二页的同一行但另一列获取一个值.

What I want to do: Iterate over values on one page to check for match on another page and if a match is found take a value from 2nd page same row but different column.

我已经尝试了一段时间了.我是VBA脚本/Excel的新手，可能无法正确解决此问题，因此为什么在这里问！！

I've been trying now for quite some time. I'm new to VBA-scripting / Excel and might be approaching the problem incorrectly, hence why I'm asking here!

到目前为止，我的代码:

My code so far:

Sub InsertData()
ScreenUpdating = False


Dim wks As Worksheet

Dim subSheet As Worksheet
Set subSheet = Sheets("Sheet4")
Dim rowRangeSub As Range
Dim LastRowSub As Long
LastRowSub = subSheet.Cells(subSheet.Rows.Count, "C").End(xlUp).Row
Set rowRangeSub = subSheet.Range("C2:C" & LastRowSub)
Dim subGroupList As ListObject


Dim rowRange As Range
Dim colRange As Range

Dim LastCol As Long
Dim LastRow As Long

Dim Found As Range
'START OF SHEET1'
Set wks = Sheets("SHEET1")
LastRow = wks.Cells(wks.Rows.Count, "B").End(xlUp).Row

Set rowRange = wks.Range("B2:B" & LastRow)
'Loop through each row in B column (Names)'
For Each rrow In rowRange
    If Not IsEmpty(rrow) Then
        With Sheets("Sheet4").Range("C2:C" & LastRowSub)

            Set Found = .Find(What:=rrow, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

            If Not Found Is Nothing Then
                'Debug.Print "Found"'
                wks.Cells(rrow.Row, "K").Value = "Found"
            Else
                wks.Cells(rrow.Row, "K").Value = "Not Found"

                'Debug.Print "Not Found"'
            End If
        End With
    End If
Next rrow

'END OF SHEET1'
'START OF SHEET2'
Set wks = Sheets("SHEET2")
LastRow = wks.Cells(wks.Rows.Count, "B").End(xlUp).Row
Set rowRange = wks.Range("B2:B" & LastRow)

'END OF SHEET2'
'START OF SHEET3'
Set wks = Sheets("SHEET3")
LastRow = wks.Cells(wks.Rows.Count, "B").End(xlUp).Row
Set rowRange = wks.Range("B2:B" & LastRow)

'END OF SHEET3'


ScreenUpdating = True
End Sub

Excel文件中的设置如下: 三张表Sheet1，Sheet2，Sheet3在其前10列(A-J)中包含大量数据，如果找到数据，则在第11列(K)中插入数据.在B列中找到了相关的数据，即名称，其中B:1仅作为标题的名称".列中还有一些空单元格需要考虑.

The setup in the Excel file is as such: The three sheets, Sheet1, Sheet2, Sheet3 contains a lot of data in its 10 first columns (A-J) and the 11th column (K) is where the data is to be inserted if it is found. Pertinent data, names, is found in column B where B:1 is just "Name" as a title. There is also some empty cells in the column to take into consideration.

第4张工作表Sheet4的前5列包含一些数据.可以在C列中找到要匹配的名称，如果找到匹配的名称，则应该从Cells(Found.Row，"E")那里收集数据，其中"E"是E列.

The 4th sheet, Sheet4 contains some data in its 5 first columns. The names which are to be matched can be found in column C, and if a match is found it is supposed to collect data from the Cells(Found.Row, "E") where "E" is column E.

这个问题一直困扰着我，因为.Find()函数似乎无法按我期望的那样工作，因为有时会发现相反的情况.

This problem has been screwing with my head quite a lot since .Find()-function seems to not work as I expect it to, as in it finds the opposites sometimes.

我的主要问题是:如何为行分配正确的值?

My main question is: How do I assign the correct value to the row?

wks.Cells(rrow.Row, "K").Value = rowRangeSub.Cells(Found.Row, "E").Value

我觉得我已经测试了至少10种不同的分配方式，但是我不断出错.在大多数情况下，这是一个不匹配错误.

I feel like I've tested at least 10 different ways to assign, but I keep on getting error after error. Most of the time it's a missmatch error.

感谢您的帮助！

自阅读评论后进行 好的，它开始了: 所有列均设置为文本格式. A栏:个人号码:不相关 B列:名称:表单为:Lastname，Firstname.在搜索匹配项时使用. C到J列与有关某个人的各种信息无关. 列K:此列单元格开始为空.这将由宏来填充.

EDIT since reading comments: Ok, here it goes : All columns are formatted as text. Column A: Personal numbers: not relevant Column B: Names: Form is: Lastname, Firstname. This is to be used when searching for a match. Column C to J not relevant with various information about a person. Column K: This columns cell starts out empty. This is to be filled by the macro.

Excel文件中有三本不同的书，它们的数据看起来像我所解释的，每本书中的数据都不同.

I have three different books within the Excel file that have data that looks like what I've explained, just different data in each book.

第4本书是这样的: A和B列与根本不需要的信息无关.

The 4th book is as such: Column A and B is not relevant with info not needed at all.

列C:是以姓氏，名字的形式出现的名称.这应该是与其他书籍中B列的单元格进行比较的列单元格.

Column C: Is the names in form Lastname, Firstname. This is what should be the column cells to compare with column B's cells in the other books.

D列:不相关

列E:这是Sheet4的重要部分.对于每个人，在此列中的每一行都可以找到一个组号".

Column E: This is the important part of Sheet4. For every person there is a "group number" that can be found in this column for every row.

我想做的是比较Sheet1-3中B列中的每个单元格，以查找Sheet4中C列中的匹配项.如果找到匹配项(并非所有匹配项都被分配了一个组，因此可能找不到匹配项)，则从找到匹配项的行和"E"列的Sheet4中获取单元格信息，并将此信息放入Sheet1-3的行中和"K"列.

What I want to do is compare each cell in column B in Sheet1-3 for a match in column C in Sheet4. If a match is found (not all are assigned a group, so matches might not be found) then take cell information from Sheet4 on the row which a match was found and column "E", put this information in the row in Sheet1-3 and column "K".

示例数据(是否可以提交表格?): Sheet1:

Example data (is there a way to submit tables?): Sheet1:

第B列

Tablesson，笔

Tablesson, Pen

纸张，墨水

橡皮擦，屏幕

COLUMN K 目前为空

第4页:

列C

纸张，墨水

橡皮擦，屏幕

列E

55

77

运行宏，在宏后 Sheet1 :

第B列

Tablesson，笔

Tablesson, Pen

纸张，墨水

橡皮擦，屏幕

第K列

[由于没有找到匹配项，因此第一个条目为空]

[First entry is empty since no match was found]

55

77

希望这是可以理解的！

推荐答案

我使用脚本字典简化了此过程.

I simplified the process by using a Scripting Dictionary.

Sub InsertData()
    Dim lastRow As Long, x As Long
    Dim dicNames, k As String, v As Variant

    Set dicNames = CreateObject("scripting.dictionary")
    'Create list of Names to compare against and values to update
    With Worksheets("Sheet4")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        For x = 2 To lastRow
        
            k = .Cells(x, 3).Value  'Name from Column C
            v = .Cells(x, 5).Value  'Value From Column E

            'Add Key Value pairs to Dictionary
            If Not dicNames.Exists(k) Then dicNames.Add k, v
        Next
    End With

    ProcessWorksheet Worksheets("Sheet1"), dicNames
    ProcessWorksheet Worksheets("Sheet2"), dicNames
    ProcessWorksheet Worksheets("Sheet3"), dicNames

End Sub

Sub ProcessWorksheet(ws As Worksheet, ByRef dicNames)
    Dim k As String, v As Range
    Dim lastRow As Long, x As Long
    With ws
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        For x = 2 To lastRow
            k = .Cells(x, 2)    'If Name from Column B
            If dicNames.Exists(k) Then
                .Cells(x, 11) = dicNames(k) 'Then Column K = Value from Sheet4
            End If
        Next
    End With
End Sub

这篇关于Excel VBA宏:遍历一页上的值以检查另一页上的匹配项并分配值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！