如果单元格匹配，则粘贴值

Question

在上一篇文章中，你们帮我找到了复制粘贴单元格的解决方案。

现在我遇到了一个稍微不同的问题。

这里是;我有两张不同的床单；

• worksheets("Food")
• Worksheets("Numbers")

在worksheets("Food")，我有以下板子；

| Fruits            | Vegetables    |
| --------          | --------------|
| Banana            | Carrots       |
| Peach             | Spinachs      |
| Pineapple         | Cauliflowers  |

在worksheets("Numbers")，我有这个；

| Fruits        | Numbers   |
| --------      | --------- |
| Banana        | 9         |
| Apple         | 2         |
| Orange        | 3         |
| Peach         | 7         |
| Pineapple     | 5         |

如果worksheets("Numbers") 中确实存在，我想搜索worksheets("Food") 中的每种水果。如果是，则自动在worksheets("Food") 中名为“Numbers”的列 Fruits 和 Vegetables 之间插入一个新列。 之后，在worksheets("Numbers")中找到每个水果旁边的数字，并将其粘贴到 worksheets("Food")新创建的列中匹配的水果旁边。

像这样;

| Fruits     |*Numbers*      |Vegetables
| --------   |-------------- |------------
| Banana     |**9**          |Carrots
| Peach      |**7**          |Spinachs
| Pineapple  |**5**          |Cauliflowers  

我一直在尝试运行执行此过程的代码，但是当我运行它时没有任何反应（也没有发生错误）... 这是它;

Sub Add_Fruits_Numbers()

Dim lastlineFood As Long
Dim lastlineRef As Long
Dim j, i, compteur As Integer
Dim x As Long, rng As range

lastlineRef = Worksheets("Numbers").range("A" & rows.Count).End(xlUp).row

For j = 1 To lastlineRef
    lastlineFood = Worksheets("Food").range("A" & rows.Count).End(xlUp).row
    
        For i = 1 To lastlineFood
        If range("A" & i).Value = Worksheets("Numbers").range("A" & j).Value Then
        
            Set rng = Worksheets("Numbers").range("A1", range("A1").End(xlToRight))
                For Each cell In rng
                    If cell.Value = "Fruits" Then
                        cell.EntireColumn.Offset(0, 1).Insert (xlShiftToRight)
                    End If
                Next cell
            
        
            Worksheets("Food").range("A" & i).Offset(, 1).Value = Worksheets("Numbers").range("A" & j).Offset(, 1)
        End If
        Next i
        


Next j
End Sub

再次感谢您的帮助，谢谢！

Answer 1

您的代码有一些问题。它应该在行上引发错误

 Set rng = Worksheets("Numbers").range("A1", range("A1").End(xlToRight))

如果活动工作表不是“数字”。 range("A1").End(xlToRight) 指的是活动工作表。正确的代码应该是：

Set rng = Worksheets("Numbers").range("A1", Worksheets("Numbers").range("A1").End(xlToRight))

然后，您的代码会在“数字”表中插入一列。 您应该使用Range("B" & i).EntireColumn.Insert 而不是cell.EntireColumn.Offset(0, 1).Insert (xlShiftToRight)。 cell 属于“数字”表中的范围。

代码逻辑错误。上述序列只能运行一次。否则它将为每个匹配插入一列。每次迭代都会有“水果”。

然后一切都搞砸了，调试更多没有意义，没有冒犯...

向您展示更简单/更快的代码，做（我理解）您想做的事情会更容易。

请尝试下一个代码：

Sub bringFruitsNo()
  Dim shF As Worksheet, shN As Worksheet, lastRF As Long, lastRN As Long
  Dim arrF, rngN As Range, mtch, i As Long, boolOK
  
  Set shF = Sheets("Food")
  Set shN = Sheets("Numbers")
  lastRF = shF.Range("A" & shF.rows.count).End(xlUp).row     'last row
  lastRN = shN.Range("A" & shN.rows.count).End(xlUp).row   'last row
  If shF.Range("B1").value = "Numbers" Then boolOK = True 'check if the column has already been inserted in a previous run
  arrF = shF.Range("A2:A" & lastRF).value 'put the first column in an array (for a faster iteration)
  Set rngN = shN.Range("A2:A" & lastRN) 'set the range where to search for the fruit existence
  
  For i = 1 To UBound(arrF)             'iterate between the array elements:
    mtch = Application.match(arrF(i, 1), rngN, 0) 'if the fruit has bee found:
    If IsNumeric(mtch) Then
        'insert the new necessary column and mark the inserting event changing the boolean variable value
        If Not boolOK Then shF.Range("B1").EntireColumn.Insert: shF.Range("B1").value = "Numbers": boolOK = True
        shF.Range("B" & i + 1) = shN.Range("B" & mtch + 1).value  'Place the number in the new column
    End If
  Next i
End Sub

但是，我认为您可能需要在插入列之后使用此代码，并且该代码正在检查“水果”和“蔬菜”之间是否存在名为“数字”的列...

如果没有必要，并且代码必须在第一列和第三列之间插入一列，则可以删除该行。