首页 > 解决方案 > 从 2 列中获取唯一值并将这些唯一值匹配到另一个工作表中以使用“OK”一词填充单元格

问题描述

我需要帮助来更正我的代码以检查2 列 G 和 AI中的唯一值(如果不为空)或名为 start 的工作表中的G 和 AJ 列,然后在名为 Final 的工作表中的A 列上查找这些唯一值匹配。当它在A 列中找到这些值时,它需要将C 列填充在与匹配号所在的同一行中,并带有单词 OK。

将始终检查 2 列的唯一值。需要检查工作表 Start上第 8 列的值+ 第 36 列的值的唯一值。但是,如果第 8 列和第 36 列为空,则代码需要检查第 7 列 + 第 35 列在此处输入图像描述

我正在使用此代码,但似乎不完整。

 Sheets("Start").Activate
    Sintrlastrow1 = Sheets("Start").Cells(Cells.Rows.Count, "A").End(xlUp).Row
    SLastColumn = Sheets("Start").Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
         Dim idsConsumerGalactic As Object
        Dim StartSheet As Range
        Dim Count As Integer
        Set StartSheet = Range(Cells(2, 1), Cells(Sintrlastrow1, SLastColumn))
        Set idsConsumerGalactic = CreateObject("Scripting.Dictionary")
        
      For Count = 2 To Sintrlastrow1
        If Sheets("Start").Cells(Count, 8).Value <> "" And Sheets("Start").Cells(Count, 36).Value <> "" Then '' --->>> columns that need to be checked for unique value 
            valor = Sheets("Interdiction").Cells(Count, 8).Value And Sheets("Start").Cells(Count, 36).Value  ''--->>> If columns H and AI is <> ""
        Else
            valor = Sheets("Start").Cells(Count, 7).Value And Sheets("Start").Cells(Count, 35).Value ''--->>> if columns H and AI is "" then needed to check conlumns G and AJ for unique values
        End If
        
            If idsConsumerGalactic.Exists(valor) Then
                idsConsumerGalactic(valor) = (idsConsumerGalactic(valor) + 1)
            Else
                idsConsumerGalactic.Add valor, 1
            End If
        Next Count
    
    Sheets("Final").Activate
        For Each consumer In idsConsumerGalactic  ''-->> Trying to loop the Final sheet to find the unique value match where is the row of the unique value and add OK on the column C  
            If (idsConsumerGalactic(consumer) = 1) Then
                Set Match = Sheets("Final").Cells.Find(What:=consumer, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows)
            If Match Then
             Sheets("Final").Cells(consumer.Row, 3).Value = "OK"
            End If
           End If
             Next 

如何检查两列的唯一值,然后在另一张表中查找它?

当代码从工作表 Final的 A 列的工作表 StartG 和 AI 列中找到唯一值时,如何用OK一词填充C 列上的单元格?

结果我需要

在图像中,消费者编号 2,4 和 5 在 G 和 AI 列中是唯一的。

标签: excelvbaexcel-formula

解决方案


这是我最好的猜测:

Sub tester()

    Dim wsStart As Worksheet, lastRow As Long, wsFinal As Worksheet
    Dim dict As Object, rw As Range, v, v2, k, m
    
    Set wsStart = ActiveWorkbook.Sheets("Start") ' or ThisWorkbook.sheets("Start") ?
    Set wsFinal = ActiveWorkbook.Sheets("Final")
    Set dict = CreateObject("Scripting.Dictionary")

    lastRow = wsStart.Cells(Cells.Rows.Count, "A").End(xlUp).Row
    For Each rw In wsStart.Range("A2:AJ" & lastRow).Rows
        v = rw.Cells(8).Value
        v2 = rw.Cells(36).Value
        
        If Len(v) = 0 Or Len(v2) = 0 Then
            v = rw.Cells(7).Value
            v2 = rw.Cells(35).Value
        End If
        
        dict(v) = dict(v) + 1
        dict(v2) = dict(v2) + 1
    Next rw
    
    For Each k In dict
        If dict(k) = 1 Then
            m = Application.Match(k, wsFinal.Columns(1), 0)
            If Not IsError(m) Then wsFinal.Cells(m, 3).Value = "OK"
        End If
    Next k
 
End Sub

推荐阅读