英文:
VBA get exact match from multiple entries on another sheet return true/false
问题
我尝试使用索引/匹配、VLOOKUP、IF语句等方法来做这个,我已经搜索了好几天(可能是因为我不知道如何正确定义我正在做的事情)。VBA对我来说是新的。
我有2个工作表,第一个工作表(dataWs)是要搜索的数据,标题为Ach。列A包含约3500行员工ID。列B包含工作职责代码。一个员工可能有1到20个工作代码条目,根据他们有资格执行的工作而定。还有其他列用于状态和到期日期,但这些与问题无关。
第2个工作表(outputWs)包含列A中的ID号码(以及列B中的联系电子邮件)。我希望列C能够在工作表1的列A中找到ID号码,然后在该ID的所有条目中,在工作表1的列B中查找工作代码53,然后在工作表2的列C中反映出员工ID是否有资格执行工作职责53,如果更简单的话,只需将"53"放在列C中也可以。
以下是一个标准的索引匹配,用于ID查找,但不考虑代码53的查找:
Sub findJobQual ()
Dim outputWs As Worksheet, dataWs As Worksheet
Dim outputLastRow As Long, dataLastRow As Long, x As Long
Dim IndexRng As Range, MatchRng As Range
'Sources
Set outputWs = ThisWorkbook.Worksheets("Qualified")
Set dataWs = ThisWorkbook.Worksheets("Ach")
'count rows in tables
outputLastRow = outputWs.Range("A" & Rows.Count).End(xlUp).Row
dataLastRow = dataWs.Range("A" & Rows.Count).End(xlUp).Row
'Data column to return values from (Desired return)
Set IndexRng = dataWs.Range("B2:B" & dataLastRow)
'Data sent match to(Row)(Column)
Set MatchRng = IndexRng.Offset(0, -1)
On Error Resume Next
For x = 2 To outputLastRow
'Send Cell
outputWs.Range("A" & x).Value = Application.WorksheetFunction.Index(IndexRng, _
Application.WorksheetFunction.Match(outputWs.Range("C" & x).Value, MatchRng, 0))
'Return Cell
Next x
End Sub
我知道上面的代码可能是不完整的,或者可能不是我尝试做的方法。我提供它作为一个模板,因为它将匹配ID号码并在工作簿的其他部分输出一个值。上面的代码可能仍然需要调整以适应我提供的信息。我知道我需要添加另一个参数,但我不确定如何添加。
英文:
I have attempted to do this with index/match, vlookup, If statements, etc. I have searched for days (It it possible I don't know how to define what I am doing properly). VBA is new to me.
I have 2 sheets, the first Sheet (dataWs) is data to search titled Ach. Column A contains employee ID's on or about 3500 rows. Column B contains job duty codes. A single employee may have 1 or 20 job code entries, based on jobs they are qualified to perform. There are other columns for status and expire date, but they are not relevant.
Sheet 2 (outputWs) contains ID numbers in column A (and a contact email in column B). I would like column C to find ID number in Sheet 1 column a, then in all entries for that ID, find job code 53 in sheet1 column B then reflect true or false if the employee ID is qualified to perform job duty 53 on Sheet 2 column C. If it is easier - putting just "53" in column c would also work.
Here is a standard index match that works for ID lookup but does not consider the code 53 lookup:
Sub findJobQual ()
Dim outputWs As Worksheet, dataWs As Worksheet
Dim outputLastRow As Long, dataLastRow As Long, x As Long
Dim IndexRng As Range, MatchRng As Range
'Sources
Set outputWs = ThisWorkbook.Worksheets("Qualified")
Set dataWs = ThisWorkbook.Worksheets("Ach")
'count rows in tables
outputLastRow = outputWs.Range("A" & Rows.Count).End(xlUp).Row
dataLastRow = dataWs.Range("A" & Rows.Count).End(xlUp).Row
'Data column to return values from (Desired return)
Set IndexRng = dataWs.Range("B2:B" & dataLastRow)
'Data sent match to(Row)(Column)
Set MatchRng = IndexRng.Offset(0, -1)
On Error Resume Next
For x = 2 To outputLastRow
'Send Cell
outputWs.Range("A" & x).Value = Application.WorksheetFunction.Index(IndexRng, _
Application.WorksheetFunction.Match(outputWs.Range("C" & x).Value, MatchRng, 0))
'Return Cell
Next x
End Sub
I am aware that the above code is incomplete or may not be the method to do what I am trying to do. I am providing it as a boiler plate, as it will match ID numbers and output a value in other parts of my workbook. the above code may still need adjustment to work with the info I have provided. I know I need to add another argument but I am not sure how.
答案1
得分: 1
以下是您要求的代码的中文翻译部分:
子 FlagJobQualifications()
常数 SRC_SHEET 作为 字符串 = "Qualified"
常数 SRC_ID_COLUMN 作为 长整型 = 1
常数 SRC_ACH_COLUMN 作为 长整型 = 2
常数 DST_SHEET 作为 字符串 = "Ach"
常数 DST_ID_COLUMN 作为 长整型 = 1
常数 DST_ACH_COLUMN 作为 长整型 = 3
常数 DST_ACH_LOOKUP_CELL 作为 字符串 = "C1"
常数 DST_ACH_PREFIX 作为 字符串 = "Code "
常数 DST_FLAG_YES = True
常数 DST_FLAG_NO = False
Dim wb 作为 工作簿: 设置 wb = ThisWorkbook
Dim sws 作为 工作表: 设置 sws = wb.Sheets(SRC_SHEET)
Dim rg 作为 范围, rCount 作为 长整型
使用 sws.Range("A1").CurrentRegion
rCount = .Rows.Count - 1
如果 rCount = 0 Then
MsgBox "工作表 """ & SRC_SHEET & """ 中没有数据。", vbCritical
退出子程序
End If
设置 rg = .Resize(rCount).Offset(1)
结束使用
Dim dict 作为 对象: 设置 dict = CreateObject("Scripting.Dictionary")
'dict.CompareMode = vbTextCompare ' 由于只涉及数字,因此不必要
Dim rrg 作为 范围, iStr 作为 字符串, aStr 作为 字符串
对于 每个 rrg 在 rg.Rows 中
iStr = CStr(rrg.Cells(SRC_ID_COLUMN).Value)
如果 Len(iStr) > 0 Then
如果 不 dict.Exists(iStr) 则
设置 dict(iStr) = CreateObject("Scripting.Dictionary")
'dict(iStr).CompareMode = vbTextCompare ' 不必要...
结束如果
aStr = CStr(rrg.Cells(SRC_ACH_COLUMN).Value)
如果 不 dict(iStr).Exists(aStr) 则
dict(iStr)(aStr) = Empty
结束如果
结束如果
下一个 rrg
如果 dict.Count = 0 Then
MsgBox "工作表 """ & SRC_SHEET & """ 中只有空白。", vbCritical
退出子程序
End If
Dim dws 作为 工作表: 设置 dws = wb.Sheets(DST_SHEET)
使用 dws.Range("A1").CurrentRegion
rCount = .Rows.Count - 1
如果 rCount = 0 Then
MsgBox "工作表 """ & DST_SHEET & """ 中没有数据。", vbCritical
退出子程序
End If
设置 rg = .Resize(rCount).Offset(1)
结束使用
Dim daCell 作为 范围: 设置 daCell = dws.Range(DST_ACH_LOOKUP_CELL)
Dim daStr 作为 字符串: daStr = CStr(daCell.Value)
如果 InStr(1, daStr, DST_ACH_PREFIX, vbTextCompare) <> 1 Then
MsgBox "字符串 'Ach' """ & daStr & """ 无效。", vbExclamation
退出子程序
结束如果
aStr = Right(daStr, Len(daStr) - Len(DST_ACH_PREFIX))
Dim IsQualified 作为 布尔值
对于 每个 rrg 在 rg.Rows 中
iStr = CStr(rrg.Cells(DST_ID_COLUMN).Value)
如果 dict.Exists(iStr) 则
如果 dict(iStr).Exists(aStr) 则
IsQualified = True
结束如果
结束如果
如果 IsQualified 则
rrg.Cells(DST_ACH_COLUMN).Value = DST_FLAG_YES
IsQualified = False ' 为下一次迭代重置
否则
rrg.Cells(DST_ACH_COLUMN).Value = DST_FLAG_NO
结束如果
下一个 rrg
MsgBox "已标记职位资格。", vbInformation
结束子程序
希望这对您有所帮助。如果您有其他问题,请随时提出。
英文:
A VBA Lookup (Dictionary of Dictionaries)
- The keys of the dictionary hold the unique Ids while the items hold dictionaries whose keys hold the Achs.
<!-- language: lang-vb -->
Sub FlagJobQualifications()
Const SRC_SHEET As String = "Qualified"
Const SRC_ID_COLUMN As Long = 1
Const SRC_ACH_COLUMN As Long = 2
Const DST_SHEET As String = "Ach"
Const DST_ID_COLUMN As Long = 1
Const DST_ACH_COLUMN As Long = 3
Const DST_ACH_LOOKUP_CELL As String = "C1"
Const DST_ACH_PREFIX As String = "Code "
Const DST_FLAG_YES = True
Const DST_FLAG_NO = False
Dim wb As Workbook: Set wb = ThisWorkbook
Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
Dim rg As Range, rCount As Long
With sws.Range("A1").CurrentRegion
rCount = .Rows.Count - 1
If rCount = 0 Then
MsgBox "No data in worksheet """ & SRC_SHEET & """.", vbCritical
Exit Sub
End If
Set rg = .Resize(rCount).Offset(1)
End With
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
'dict.CompareMode = vbTextCompare ' not necessary since only digits
Dim rrg As Range, iStr As String, aStr As String
For Each rrg In rg.Rows
iStr = CStr(rrg.Cells(SRC_ID_COLUMN).Value)
If Len(iStr) > 0 Then
If Not dict.Exists(iStr) Then
Set dict(iStr) = CreateObject("Scripting.Dictionary")
'dict(iStr).CompareMode = vbTextCompare ' not necessary...
End If
aStr = CStr(rrg.Cells(SRC_ACH_COLUMN).Value)
If Not dict(iStr).Exists(aStr) Then
dict(iStr)(aStr) = Empty
End If
End If
Next rrg
If dict.Count = 0 Then
MsgBox "Only blanks in worksheet """ & SRC_SHEET & """.", vbCritical
Exit Sub
End If
Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
With dws.Range("A1").CurrentRegion
rCount = .Rows.Count - 1
If rCount = 0 Then
MsgBox "No data in worksheet """ & DST_SHEET & """.", vbCritical
Exit Sub
End If
Set rg = .Resize(rCount).Offset(1)
End With
Dim daCell As Range: Set daCell = dws.Range(DST_ACH_LOOKUP_CELL)
Dim daStr As String: daStr = CStr(daCell.Value)
If InStr(1, daStr, DST_ACH_PREFIX, vbTextCompare) <> 1 Then
MsgBox "The 'Ach' string """ & daStr & """ is invalid.", vbExclamation
Exit Sub
End If
aStr = Right(daStr, Len(daStr) - Len(DST_ACH_PREFIX))
Dim IsQualified As Boolean
For Each rrg In rg.Rows
iStr = CStr(rrg.Cells(DST_ID_COLUMN).Value)
If dict.Exists(iStr) Then
If dict(iStr).Exists(aStr) Then
IsQualified = True
End If
End If
If IsQualified Then
rrg.Cells(DST_ACH_COLUMN).Value = DST_FLAG_YES
IsQualified = False ' reset for the next iteration
Else
rrg.Cells(DST_ACH_COLUMN).Value = DST_FLAG_NO
End If
Next rrg
MsgBox "Job qualifications flagged.", vbInformation
End Sub
答案2
得分: 0
=NOT(ISERROR(MATCH(A2&"|53",Ach!$A$2:$A$2500&"|"&Ach!$B$2:$B$2500,0)))
英文:
Maybe you can try a formula like below (to be entered in column c in the second sheet
=NOT(ISERROR(MATCH(A2&"|53",Ach!$A$2:$A$2500&"|"&Ach!$B$2:$B$2500,0)))
答案3
得分: 0
probably we have different layout in sheets, and my formula didn't work.
Also your code works only if I exchange "C" <-> "A" in the For loop, but it is not important.
如果您的代码能够匹配单元格,那么可能最简单的测试方法就是在末尾添加 "=53" 进行测试。
当然,您也可以使用变量并从另一个单元格中读取它等。
outputWs.Range("A" & x).Value = Application.WorksheetFunction.Index(IndexRng, _
Application.WorksheetFunction.Match(outputWs.Range("C" & x).Value, MatchRng, 0)) = 53
英文:
probably we have different layout in sheets, and my formula didn't work.
Also your code works only if I exchange "C"<->"A" in the For loop, but it is not important.
If your code works for matching the cells so probably the simpliest measure to check it against 53 id just to add "=53" at the end to make a test.
Of course you can use a variable and read it from another cell etc.
outputWs.Range("A" & x).Value = Application.WorksheetFunction.Index(IndexRng, _
Application.WorksheetFunction.Match(outputWs.Range("C" & x).Value, MatchRng, 0)) = 53
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论