如果单元格具有可以在另一张表中找到的相同值，则在单元格中写入随机值答案

【问题标题】：Write a random value in a cell if the cell has the same value that can be found in another sheet如果单元格具有可以在另一张表中找到的相同值，则在单元格中写入随机值
【发布时间】：2020-05-22 12:19:29
【问题描述】：

我在一个 excel 文件中有以下两张表。我需要一个 VBA 代码，它将在 Status 列中写入值“已完成”，但前提是在 Sheet2 中找到 ID。因此，例如，在 Sheet1 中，我希望 ID 1 的状态为“已完成”，但 ID 2 的状态为空白单元格，因为在 Sheet2 中找不到 ID2。我想用一个 for each 来做到这一点，因为它比简单的 IF 公式工作得更快，但我似乎找不到可以工作的代码。谢谢

Sheet1:
----------------------------------
ID |  Product | Date      | Status
-----------------------------------
1  |   abc    | 05-Jan-19 |
2  |   abc    | 07-Jan-18 |
3  |   def    | 05-Apr-19 |
4  |   ghi    | 06-Feb-19 |

Sheet2:
-------------
ID | Product  
-------------
1  | abc       
3  | def     
4  | ghi

【问题讨论】：

您可以使用简单的 COUNTIF 或 MATCH 公式来完成此操作。
公式在这里就足够了，为什么需要VBA？
它是复杂 VBA 代码的一部分，这是我需要做的一步，而且需要快速完成。

标签： excel vba for-loop foreach

【解决方案1】：

使用数组很快。

Sub setStatus()
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Dim rngDB As Range
    Dim vDB, vR()
    Dim i As Long, n As Long

    Set Ws1 = Sheets(1)
    Set Ws2 = Sheets(2)

    With Ws1
        vDB = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
    End With
    With Ws2
        Set rngDB = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
    End With

    n = UBound(vDB, 1)
    ReDim vR(1 To n, 1 To 1)
    For i = 1 To n
        If WorksheetFunction.CountIf(rngDB, vDB(i, 1)) Then
            vR(i, 1) = "Completed"
        End If
    Next i
    Ws1.Range("d2").Resize(n) = vR
End Sub

【讨论】：

【解决方案2】：

=IF(ISNA(MATCH(A4;Sheet2!$A$2:$A$6;0));"";"Completed")

A4 是 Sheet1 中状态列中的一个单元格
$A$2:$A$6 是 Sheet2 中的 id 范围。

只需将此公式应用于 Sheet1 中状态列中的所有单元格。

【讨论】：

【解决方案3】：

TheReddsable你也可以试试下面的代码

选项显式 Dim awb, product_id As String 暗淡 sht_1_count, sht_2_count, loop_i, loop_d As Double 子 get_status() awb = ActiveWorkbook.Name sht_1_count = Workbooks(awb).Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row sht_2_count = Workbooks(awb).Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row 对于 loop_i = 2 到 sht_1_count product_id = Workbooks(awb).Sheets("Sheet1").Cells(loop_i, 1) 对于 loop_d = 2 到 sht_2_count 如果 LCase(Trim(product_id)) = LCase(Trim(Workbooks(awb).Sheets("Sheet2").Cells(loop_d, 1))) 那么 Workbooks(awb).Sheets("Sheet1").Cells(loop_i, 4) = "完成" 退出万一下一个循环_d 下一个循环_i 结束子

【讨论】：

【解决方案4】：

我假设两个范围都从 A1 开始编写代码。请测试一下！

Sub BringVal()
 Dim sh1 As Worksheet, sh2 As Worksheet, arrCheck As Variant, arrMatch As Variant
 Dim lastRow1 As Long, lastRow2 As Long, i As Long, j As Long, arrRez As Variant
 Dim boolF As Boolean
   Set sh1 = Sheets(1): Set sh2 = Sheets(2) 'use here your real sheets!
   lastRow1 = sh1.Range("A" & sh1.Rows.count).End(xlUp).Row
   lastRow2 = sh2.Range("A" & sh2.Rows.count).End(xlUp).Row

   arrCheck = sh1.Range("A2:A" & lastRow1).Value
   arrMatch = sh2.Range("A2:B" & lastRow2).Value
   ReDim arrRez(1 To UBound(arrCheck))
   For i = 1 To UBound(arrCheck)
        For j = 1 To UBound(arrMatch, 1)
            If arrCheck(i, 1) = arrMatch(j, 1) Then
                boolF = True
                arrRez(i) = arrMatch(j, 2): Exit For
            End If
        Next j
        If Not boolF Then arrRez(i) = Empty
   Next i
   If UBound(arrRez) > 0 _
        Then sh1.Range("D2:D" & UBound(arrRez) + 1).Value = _
        WorksheetFunction.Transpose(arrRez)
End Sub

代码应该非常快，因为它只在内存中工作并且一次删除所有收集的数据。如果您需要在未找到任何匹配的情况下发送消息，那么在最后一个 If 之后添加一个 Else ... End If 序列非常容易...

【讨论】：