回答受付が終了しました

エクセルVBA 下記リンクの私の質問に関連した質問です。 https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12239441737?post=1

Visual Basic | Excel62閲覧xmlns="http://www.w3.org/2000/svg">500

回答(2件)

0

ABで重複を許すようにしました。 全てのパターンを並べ替えてから書き込み、最後に重複の削除をしています。 Option Explicit ' Sub Macro1()     Dim Separate As Integer     Dim CountA As Integer     Dim CountB As Integer     Dim Arr(6) As Integer     Dim NowData(1 To 6) As Integer     Dim RInp As Integer     Dim ROut As Long     Dim CInp As Integer     Dim COut As Integer '     Separate = [CountIf(D1:I1,"A")]     CountA = [Count(A:A)]     CountB = [Count(B:B)]     ROut = 2     Range("D2:I" & Rows.Count).ClearContents     Application.ScreenUpdating = False '     Do While Arr(0) = 0 '         For COut = 1 To 6             CInp = 1 - (COut > Separate)             RInp = Arr(COut) + 2             NowData(COut) = Cells(RInp, CInp)         Next COut '         For COut = 1 To 6             Cells(ROut, COut + 3) = WorksheetFunction.Small(NowData, COut)         Next COut '         Do             COut = COut - 1             Arr(COut) = Arr(COut) + 1         Loop While Arr(COut) = IIf(COut <= Separate, CountA, CountB)         RInp = Arr(COut) '         For COut = COut + 1 To 6             Arr(COut) = RInp '             If COut = Separate Then                 RInp = 0             End If         Next COut         ROut = ROut + 1     Loop     [D:I].RemoveDuplicates Array(1, 2, 3, 4, 5, 6), xlYes End Sub

0

回答します。 >AかBをそれぞれ入力した後マクロを実行することで、Aの組またはBの組に相当するそれぞれの数字を重複ありで6つ選ぶ際の全ての組み合わせをD~I列の最終行に入力するコードを教えてください。 →AかBを選び、6つの数値を選んでからマクロを実行するのはないのでしょうか? それから、「6つを選ぶ」というのは何からどうやって選ばせる想定でしょうか? とりあえず、選ばせる方法が分からないので、A列にある6つの値の全パターンを羅列するスクリプトを作成しましたので、参考にしてください。 ■サンプルプログラム Private Const MAX_COL As Integer = 6 Private Const MAX_ROW As Long = MAX_COL ^ MAX_COL Sub Main() Dim lCol As Integer Dim rng As Range Dim lRow As Long Dim lCount As Long Application.ScreenUpdating = False For lCol = 1 To MAX_COL lRow = 2 Do For Each rng In ActiveSheet.Cells(2, 1).Resize(6, 1) For lCount = 1 To MAX_ROW / (MAX_COL ^ lCol) ActiveSheet.Cells(lRow, lCol + 3).Value = rng.Value lRow = lRow + 1 Next Next If lRow > MAX_ROW Then Exit Do Loop Next Application.ScreenUpdating = True MsgBox "完了!!", vbInformation, "情報" End Sub

回答ありがとうございます。 私がこれでやりたいことはlarさんの言うように、「D1~I1に入力されたアルファベットに対応する数字の全パターンを入力すること」です。例えばAAAAAAと入力したのであれば462通りのパターンを、BBBBBBと入力したのであれば8008通りのパターンが表示されるようにしたいです。