가변 조합 작성자

Question

나는 다양한 수준의 변수를 최대 7 개까지 조합하여 작성하고 작성해야하는 VBA 프로그램이 있습니다.

코드가 모든 조합을 반복하고 각 변수 사이의 공백으로 씁니다. 그것은 마지막 줄 (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` 

전류 출력의 예는 여기에서 : 사용되는 변수 및 각 변수의 수치의 수가 이후

다음 I은 각 조합을 작성하는 데 사용하는 코드이다 이 문제를 해결하기 위해 다차원 배열을 사용할 수 있는지 확신 할 수 없을 때마다 변경됩니다. "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