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”更改為適當的情況。 即使更改可能更復雜，如果您可以描述更改算法背后的邏輯，我可以嘗試針對每種情況調整公式...