根据if逻辑来乘以多个列

我试图制定vba的逻辑，将基于标题名称乘以一列其他列的单元格。 例如，如果我有以下数据：

在列I中，我试图用D2：D11乘以B2：B11的单元格范围A2：A11。 由于A1中的值与D1中的左边两个字符相同，B1与D1中的右边两个字符相同。 在J列中，将是单元格范围A2：A11乘以E2：E11等等。 结果应该如下所示：

macros正在尝试通过比较单元格A1：B1到D1：G1中的单元格值，但我无法弄清楚如何将3个单元格区域相乘。

VBA：

Sub IfThenLogic2() Dim SrchRng1 As Range, cel1 As Range Dim SrchRng2 As Range, cel2 As Range Set SrchRng1 = Sheets("Sheet2").Range("A1:B1") Set SrchRng2 = Sheets("Sheet2").Range("F1:G1") c = 13 For Each cel1 In SrchRng1 For Each cel2 In SrchRng2 If (cel1.Value = Left(cel2.Value, 2) Or cel1.Value = Right(cel2.Value, 2)) Then 'If cel1.Value = cel2.Value Then For r = 2 To 11 Cells(r, c).FormulaR1C1 = "=" & cel1.Offset(r - 1, 0).Address(ReferenceStyle:=xlR1C1) & "*" & cel2.Offset(r - 1, 0).Address(ReferenceStyle:=xlR1C1) & "" Next r c = c + 1 End If Next cel2 Next cel1 End Sub 

OR运算符产生（按预期）：

有没有更好的方法来完成这个不使用for each loops ？ 感谢您的任何build议！

Answer 1

如果你想在VBA中：

 Sub IfThenLogic2() Dim SrchRng1 As Range, cel1 As Range Dim SrchRng2 As Range, cel2 As Range Dim i As Integer Dim sht As Worksheet Set sht = Sheets("Sheet2") Set SrchRng1 = sht.Range("A1:B1") Set SrchRng2 = sht.Range("D1:G1") Dim title() As String c = 13 For Each cel1 In SrchRng1 For Each cel2 In SrchRng2 title = Split(cel2, "_") For i = LBound(title) To UBound(title) If title(i) = cel1.Value Then 'If cel1.Value = cel2.Value Then For r = 2 To 11 If sht.Cells(r, c).HasFormula Then sht.Cells(r, c).Formula = sht.Cells(r, c).Formula & "*" & cel1.Offset(r - 1, 0).Address Else sht.Cells(r, c).Formula = "=" & cel1.Offset(r - 1, 0).Address & "*" & cel2.Offset(r - 1, 0).Address End If Next r End If Next i c = c + 1 Next cel2 c = 13 Next cel1 End Sub 

Answer 2

这是一个正常的（非数组）公式来做到这一点。 只要input到单元格I2并根据需要复制：

 =INDEX($D2:$G2,MATCH(I$1,$D$1:$G$1,)) * IFERROR(INDEX($A2:$B2,MATCH(LEFT(I$1,2),$A$1:$B$1,)),1) * IFERROR(INDEX($A2:$B2,MATCH(RIGHT(I$1,2),$A$1:$B$1,)),1) 

如果你想这个自动化，你可以使用这个VBA：

 Public Sub excelhero() [i2].Formula = "=INDEX($D2:$G2,MATCH(I$1,$D$1:$G$1,)) * IFERROR(INDEX($A2:$B2,MATCH(LEFT(I$1,2),$A$1:$B$1,)),1) * IFERROR(INDEX($A2:$B2,MATCH(RIGHT(I$1,2),$A$1:$B$1,)),1)" [i2].Copy [i2:L11] [i2:L11].Value = [i2:L1].Value '<-- replaces formulas with literal values End Sub 

Answer 3

如果你不介意一个公式，我得到一个数组公式，工作。

数据是如何布置的（如果您的公式不同，您可能需要调整公式）：

I2的公式是： =IF(AND(COUNTIF($A$1:$G$1,LEFT(I$1,2)),COUNTIF($A$1:$G$1,RIGHT(I$1,2))),INDEX($A2:$G2,,MATCH(LEFT(I$1,2),$A$1:$B$1,0))*INDEX($A2:$G2,,MATCH(RIGHT(I$1,2),$A$1:$B$1,0))*INDEX($A2:$G2,,MATCH(I$1,$A$1:$G$1,0)),INDEX($A2:$G2,,MATCH(RIGHT(I$1,2),$A$1:$B$1,0))*INDEX($A2:$G2,,MATCH(I$1,$A$1:$G$1,0)))

并用CTRL+SHIFT+ENTER 。 只需按ENTER 。

这基本上是三个索引/匹配公式相乘在一起。 索引/匹配使用标题的左右两个字符来查找具有适当编号的列。

PS：对于其他人来说，这是以文本forms显示信息的表格（所以你可以复制/粘贴）。 括号表示分隔其他的空列。

 A1 A5 [] A1_A5 A3_A1 A3_A5 A9_A5 [] A1_A5 A3_A1 A3_A5 A9_A5 16 16 61 17 38 46 41 6 6 58 22 95 39 38 19 37 92 14 98 99 64 74 53 88 14 35 92 47 34 58 18 76 93 20 54 25 94 47 78 37 96 44 32 25 61 61 66 39 9 74 31 43 75 22 8 19 14 83 9 89