VBA根据单元格值放置公式

Question

我需要帮助，这里我的代码第一个问题是它给我编译错误，它也在选择源工作表但是当我定义单元格引用和工作表引用时，它没有选择相应的单元格

我要做的就是检查工作表“POWER BI”的单元格 H5 是否为“ETA1”，然后选择工作表“Source”中的单元格“U6”，否则如果它是“ETA2”，则选择工作表“Source”的“AB6”等等一直到12

当它找到相应的单元格时，将第一个给定的公式放在该单元格中第二个公式在其相邻单元格中，第三个公式与第二个公式单元格相邻

第一个公式：

FormulaR1C1 = "=IFERROR(INDEX(CCC_[ETA1],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"

公式二：

FormulaR1C1 = "=IFERROR(INDEX(CCC_[ETD],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"

第三个公式：

FormulaR1C1 = "=IFERROR(INDEX(CCC_[VESSEL],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"

Sub placeETA()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("POWER BI")

Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Source")

ws1.Select

If ws1.Range("H5").Value = "ETA1" Then ws2.Range("U6").Select

ElseIf ws1.Range("H5").Value = "ETA2" Then ws2.Range("AB6").Select

ElseIf ws1.Range("H5").Value = "ETA3" Then ws2.Range("AI6").Select

ElseIf ws1.Range("H5").Value = "ETA4" Then ws2.Range("AP6").Select

ElseIf ws1.Range("H5").Value = "ETA5" Then ws2.Range("AW6").Select

ElseIf ws1.Range("H5").Value = "ETA6" Then ws2.Range("BD6").Select

ElseIf ws1.Range("H5").Value = "ETA7" Then ws2.Range("BK6").Select

ElseIf ws1.Range("H5").Value = "ETA8" Then ws2.Range("BR6").Select

ElseIf ws1.Range("H5").Value = "ETA9" Then ws2.Range("BY6").Select

ElseIf ws1.Range("H5").Value = "ETA10" Then ws2.Range("CF6").Select

ElseIf ws1.Range("H5").Value = "ETA11" Then ws2.Range("CM6").Select

ElseIf ws1.Range("H5").Value = "ETA12" Then ws2.Range("CT6").Select

Else

End If 

End Sub

Answer 1

请尝试下一个更新的代码。 我认为不需要任何选择。 Select , Activate只消耗 Excel 资源，不带来任何好处：

Sub placeETA()
 Dim formula1 As String, formula2 As String, formula3 As String, ws1 As Worksheet, ws2 As Worksheet, specCell As Range
 
 formula1 = "=IFERROR(INDEX(CCC_[ETA1],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"
 formula2 = "=IFERROR(INDEX(CCC_[ETD],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"
 formula3 = "=IFERROR(INDEX(CCC_[VESSEL],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"
 
 Set ws1 = ThisWorkbook.Sheets("POWER BI")
 Set ws2 = ThisWorkbook.Sheets("Source")


If ws1.Range("H5").value = "ETA1" Then
        Set specCell = ws2.Range("U6")
ElseIf ws1.Range("H5").value = "ETA2" Then
         Set specCell = ws2.Range("AB6")
ElseIf ws1.Range("H5").value = "ETA3" Then
        Set specCell = ws2.Range("AI6")
ElseIf ws1.Range("H5").value = "ETA4" Then
        Set specCell = ws2.Range("AP6")
ElseIf ws1.Range("H5").value = "ETA5" Then
        Set specCell = ws2.Range("AW6")
ElseIf ws1.Range("H5").value = "ETA6" Then
        Set specCell = ws2.Range("BD6")
ElseIf ws1.Range("H5").value = "ETA7" Then
        Set specCell = ws2.Range("BK6")
ElseIf ws1.Range("H5").value = "ETA8" Then
        Set specCell = ws2.Range("BR6")
ElseIf ws1.Range("H5").value = "ETA9" Then
        Set specCell = ws2.Range("BY6")
ElseIf ws1.Range("H5").value = "ETA10" Then
        Set specCell = ws2.Range("CF6")
ElseIf ws1.Range("H5").value = "ETA11" Then
        Set specCell = ws2.Range("CM6")
ElseIf ws1.Range("H5").value = "ETA12" Then
        Set specCell = ws2.Range("CT6")
Else
End If
   specCell.Formula = formula1
   specCell.Offset(, 1).Formula = formula2
   specCell.Offset(, 2).Formula = formula3
End Sub

未经测试，但如果我正确理解了你的问题，它应该可以工作......

编辑：

下一个版本对每种情况接受不同的公式：

Sub placeETASpec()
 Dim ws1 As Worksheet, ws2 As Worksheet, specCell As Range
 
 Set ws1 = ThisWorkbook.Sheets("POWER BI")
 Set ws2 = ThisWorkbook.Sheets("Source")

 If ws1.Range("H5").value = "ETA1" Then
        Set specCell = ws2.Range("U6")
        With specCell
            .Formula = "=IFERROR(INDEX(CCC_[ETA1],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"
            .Offset(, 1).Formula = "=IFERROR(INDEX(CCC_[ETD],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"
            .Offset(, 2).Formula = "=IFERROR(INDEX(CCC_[VESSEL],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"
        End With
 ElseIf ws1.Range("H5").value = "ETA2" Then
         Set specCell = ws2.Range("AB6")
         With specCell
            .Formula = "=IFERROR(INDEX(CCC_[ETA2],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"
            .Offset(, 1).Formula = "=IFERROR(INDEX(CCC_[ETD],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"
            .Offset(, 2).Formula = "=IFERROR(INDEX(CCC_[VESSEL],MATCH([@[Purchasing Document50]],CCC_[Purchasing Document38],0)),"""")"
        End With
 ElseIf ws1.Range("H5").value = "ETA3" Then
        Set specCell = ws2.Range("AI6")
        'and so on in the rest of the cases...
        
 ElseIf ws1.Range("H5").value = "ETA4" Then
        Set specCell = ws2.Range("AP6")
 ElseIf ws1.Range("H5").value = "ETA5" Then
        Set specCell = ws2.Range("AW6")
 ElseIf ws1.Range("H5").value = "ETA6" Then
        Set specCell = ws2.Range("BD6")
 ElseIf ws1.Range("H5").value = "ETA7" Then
        Set specCell = ws2.Range("BK6")
 ElseIf ws1.Range("H5").value = "ETA8" Then
        Set specCell = ws2.Range("BR6")
 ElseIf ws1.Range("H5").value = "ETA9" Then
        Set specCell = ws2.Range("BY6")
 ElseIf ws1.Range("H5").value = "ETA10" Then
        Set specCell = ws2.Range("CF6")
 ElseIf ws1.Range("H5").value = "ETA11" Then
        Set specCell = ws2.Range("CM6")
 ElseIf ws1.Range("H5").value = "ETA12" Then
        Set specCell = ws2.Range("CT6")
 Else
 End If
End Sub

我不知道我在第二种情况下想象的公式是否是您要查找的公式。 如果是，您可以保留初始情况，但调整公式以将“ETA1”更改为适当的情况。 即使更改可能更复杂，如果您可以描述更改算法背后的逻辑，我可以尝试针对每种情况调整公式...