VBA无法在组合生成器循环中设置条件

Question

前几天有人已经在调整此代码方面提供了很大帮助，但我现在必须添加一个条件，即不创建组合，但必须确保 B、D 和 F 列仅在 Column 中的值混合时A、C 和 E 相互匹配。让我告诉你我的意思：

Region 1	Item 1	Region 2	Item 2	Region 3	Item 3
EMEA	ABC	EMEA	123	US	one
US	DEF	US	456	EMEA	two

因此，最终结果应如下所示：

• ABC-123-二
• DEF-456-一

我尝试在当前代码中设置一些内容，但失败了并将其从代码中删除。理想情况下需要发生的是它首先忽略范围内的任何空值，然后检查该区域是否等于第二项或第三项中的区域。

这是 VBA，任何建议都将不胜感激。提前致谢：

Sub CombinationGenerator()

Dim xDRg1 As Range, xDRg2 As Range, xDRg3 As Range
Dim xRg  As Range
Dim xStr As String
Dim xFN1 As Range, xFN2 As Range, xFN3 As Range
Dim xSV1 As String, xSV2 As String, xSV3 As String

Set xDRg1 = Range("B2:B75")  'First column combintation data
Set xDRg2 = Range("D2:D75")  'Second column combintation data
Set xDRg3 = Range("F2:F75")  'Third column combintation data
xStr = "-"   'Separator
Set xRg = Range("I2")  'Output cell

'Creating combinations
For Each xFN1 In xDRg1.Cells
If xFN1 <> "" Then 'Ignore empty cells
    xSV1 = xFN1.Text

    For Each xFN2 In xDRg2.Cells
        If xFN2 <> "" Then 'Ignore empty cells
        xSV2 = xFN2.Text

      For Each xFN3 In xDRg3.Cells
        If xFN3 <> "" Then 'Ignore empty cells
        xSV3 = xFN3.Text
        
        xRg.Value = xSV1 & xStr & xSV2 & xStr & xSV3
        Set xRg = xRg.Offset(1, 0)
            End If
       Next
       End If
    Next
End If
Next
End Sub

Answer 1

Sub combo()

    Dim ar, n As Long, x As Long, y As Long
    Dim z As Long, r As Long
    Dim t0 As Single: t0 = Timer
    ar = Sheet1.UsedRange.Value2
    n = UBound(ar)
    r = 1
    
    For x = 2 To n
        If Len(ar(x, 1)) > 0 Then
            For y = 2 To n
                If ar(x, 1) = ar(y, 3) Then
                    For z = 2 To n
                        If ar(x, 1) = ar(z, 3) Then
                             r = r + 1
                             Sheet2.Cells(r, "I").Value2 = ar(x, 2) & "-" & ar(y, 4) & "-" & ar(z, 6)
                        End If
                    Next
                End If
            Next
        End If
    Next
    MsgBox r - 1 & " lines", vbInformation, Format(Timer - t0, "0.0 secs")

Answer 2

鉴于您的数据已将相关信息合并在一起，即在区域和项目配对中，请考虑使用 SQL 解决方案。不需要循环并且可以有效地扩展。如果您使用 Excel for Windows（不是 Mac）连接到 Access 引擎，则可以直接在 Excel VBA 中的表格结构工作表上运行 SQL。

下面的 SQL 在同一个工作表上运行自联接，将配对分解为按区域相关的自己的表。 （括号是必需的。）

SELECT s1.[Region 1]
     , s1.[Item 1]
     , s2.[Item 2]
     , s3.[Item 3]
FROM (([Sheet1$] s1
LEFT JOIN [Sheet1$] s2
   ON s1.[Region 1] = s2.[Region 2])
LEFT JOIN [Sheet1$] s3
   ON s1.[Region 1] = s3.[Region 3])

要通过 ODBC 连接到工作簿运行上述查询，请参阅我过去的众多 VBA 答案：

• Nested SQL Select query in Excel with VBA

• How to implement a SQL Group By statement in VBA

• VBA recursive "For loops" Permutation?

• VBA - How to Extract Specific Data from another Workbook

• Other Excel VBA SQL Answers

---

此外，如果没有 VBA，如果您安装了 MS Access，您可以 link your Excel worksheet 并运行相同的 SQL 换出 [Sheet1$]。或者，在 Accces 中直接在外部工作簿上运行查询：

SELECT s1.[Region 1]
     , s1.[Item 1]
     , s2.[Item 2]
     , s3.[Item 3]
FROM (([Excel 12.0 Xml;HDR=Yes;Database=C:\Path\To\Workbook.xlsx].[Sheet1$] AS s1
LEFT JOIN [Excel 12.0 Xml;HDR=Yes;Database=C:\Path\To\Workbook.xlsx].[Sheet1$] s2
   ON s1.[Region 1] = s2.[Region 2])
LEFT JOIN [Excel 12.0 Xml;HDR=Yes;Database=C:\Path\To\Workbook.xlsx].[Sheet1$] s3
   ON s1.[Region 1] = s3.[Region 3])