2017-12-12 12 views
1

私はVBAプログラムを作成して、最大7つの異なる変数を完全に組み合わせて書き出す必要があります。可変コンビネーションライター

コードはすべての組み合わせをループし、各変数の間にスペースを入れて書き込みます。最後の行(LineP)から最初の行(Line1〜Line6)まで整理されます。

これまでのコードは、ユーザーが行を空白のままにしておくと、配列が空であるために組み合わせがないことを前提としています。 配列を定義するを ""とすることでこの問題を解決できましたが、その組み合わせで変数間に余分な2つのスペースが残っています。 コードが今働く方法は、変数の場所に何も書き込まないだけでなく、スペースを削除することも含まれます。

各変数の異なるレベルは配列に格納されます(変数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` 

電流出力の例はここにある:使用される変数と、各変数のレベルの数ので

enter image description here

以下私は現在、それぞれの組み合わせを書き出すために使用するコードでありますこれを解決するために多次元配列を使用できるかどうかわからないたびに変更されます。私は "Labeli"文字列内にifステートメントを埋め込むことは可能かもしれないと考えましたが、それが可能であることを示唆するものは何も見つかりませんでした。どんな助けでも大歓迎です。ありがとう!

答えて

0

私が試したし、次の項目をテストし、それはあなたがそれを期待しました:そうそう、それは多くの理にかなって

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 
+0

。ありがとう! – YTYT

+0

残念ながら、 'iX = 0〜UBound(ArrayX)'のために配列が空の場合、コンビネーションループは何も書きません。私はこれをどのように修正できるか知っていますか? – YTYT

+0

@YTYT、私は試してみましたが、更新された答えをテストしました。また、これがあなたを助けてくれたら、私の回答を答えにすることができますか?ありがとう。 – Xabier