Question

我有VBA程序，应该创建并写出最多7个不同变量的完整组合，每个变量都有不同的级别。

然后代码循环所有组合并用每个变量之间的空格写出它们。它首先按最后一行（LineP）进行组织，然后从第一行到最后一行（第1行到第6行）进行组织。

代码到目前为止工作，除了如果用户将行留空，则假定没有组合，因为数组为空。我可以通过将将数组定义为“”来解决这个问题，但这会在组合中的变量之间留下额外的两个空格。代码的工作方式现在不仅不会在变量的位置写入任何内容，还会删除空格。

每个变量的不同级别存储在一个数组中（变量1的级别在Array1中，变量P的级别在ArrayP中，等等）。下面是我目前用来写出每个组合的代码：

`'Create Label Combinations
If Rowi > 1 Then
    Dim Labeli As String
    Dim Rowi2 As Integer
    Rowi2 = Rowi
    If P = 1 Then
        For iP = 0 To UBound(ArrayP)
            For i1 = 0 To UBound(Array1)
                For i2 = 0 To UBound(Array2)
                    For i3 = 0 To UBound(Array3)
                        For i4 = 0 To UBound(Array4)
                            For i5 = 0 To UBound(Array5)
                                For i6 = 0 To UBound(Array6)
                                  Labeli = Array1(i1) & " " & Array2(i2) & _ 
                                         " " & Array3(i3) & " " & _  
                                           Array4(i4) & " " & Array5(i5) & _ 
                                         " " & Array6(i6) & " " & ArrayP(iP)
                                    Cells(Rowi2, 1).Value = Labeli
                                    Rowi2 = Rowi2 + 1
                                Next i6
                            Next i5
                        Next i4
                    Next i3
                Next i2
            Next i1
        Next iP
    End If
End If`

当前输出的示例如下：

由于每次使用变量的数量和每个变量的级别都会发生变化，因此我不确定是否可以使用多维数组来解决这个问题。我认为有可能在“Labeli”字符串中嵌入一个if语句，但我没有发现任何暗示可行的内容。任何帮助将非常感激。谢谢！

Answer 1

我已经尝试并测试了以下内容，它可以满足您的期望：

Private Sub CommandButton1_Click()
LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Rowi = LastRow + 1
If TextBox1.Text <> "" Then
    TempArray1 = Split(TextBox1.Text, ",")
Else
    TempArray1 = Array(" ")
End If

If TextBox2.Text <> "" Then
    TempArray2 = Split(TextBox2.Text, ",")
Else
    TempArray2 = Array(" ") 'if text box is empty add a space to the array (we'll remove the space later)
End If

If TextBox3.Text <> "" Then
    TempArray3 = Split(TextBox3.Text, ",")
Else
    TempArray3 = Array(" ")
End If

If TextBox4.Text <> "" Then
    TempArray4 = Split(TextBox4.Text, ",")
Else
    TempArray4 = Array(" ")
End If

If TextBox5.Text <> "" Then
    TempArray5 = Split(TextBox5.Text, ",")
Else
    TempArray5 = Array(" ")
End If

If TextBox6.Text <> "" Then
    TempArray6 = Split(TextBox6.Text, ",")
Else
    TempArray6 = Array(" ")
End If

If TextBox7.Text <> "" Then
    TempArray7 = Split(TextBox7.Text, ",")
Else
    TempArray7 = Array(" ")
End If

For i1 = 0 To UBound(TempArray1)
    For i2 = 0 To UBound(TempArray2)
        For i3 = 0 To UBound(TempArray3)
            For i4 = 0 To UBound(TempArray4)
                For i5 = 0 To UBound(TempArray5)
                    For i6 = 0 To UBound(TempArray6)
                        For i7 = 0 To UBound(TempArray7)
                            Labeli = TempArray1(i1) & " " & TempArray2(i2) & " " & TempArray3(i3) & " " & TempArray4(i4) & " " & TempArray5(i5) & " " & TempArray6(i6) & " " & TempArray7(i7)
                            Sheet1.Cells(Rowi, 1).Value = Trim(Labeli) 'Change Sheet1 to your Sheets("YourSheetName") or to ActiveSheet
                            Rowi = Rowi + 1
                        Next i7
                    Next i6
                Next i5
            Next i4
        Next i3
    Next i2
Next i1
SpaceKiller 'call spacekiller function to remove all the extra spaces
End Sub

Sub SpaceKiller()
   Worksheets("Sheet1").Columns("A").Replace _
      What:="  ", _
      Replacement:=" ", _
      SearchOrder:=xlByColumns, _
      MatchCase:=True
'Change Sheet1 to your Sheets("YourSheetName") or to ActiveSheet
   Set r = Worksheets("Sheet1").Columns("A").Find(What:="  ")
   If r Is Nothing Then
   Else
      Call SpaceKiller
   End If
End Sub

变量组合作家

1 个答案: