http://q.hatena.ne.jp/1198851729

組み合わせを求めるって、こういう方法しか思いつかないなぁ。。。

Sub test()

    Dim moji As String
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim d As Integer
    Dim e As Integer
    Dim f As Integer
    Dim g As Integer
    Dim h As Integer

    moji = "ABCDEFGH"
    For a = 1 To 8
     For b = 1 To 8
      If (a <> b) Then
       For c = 1 To 8
        If (c <> a And c <> b) Then
         For d = 1 To 8
          If (d <> a And d <> b And d <> c) Then
           For e = 1 To 8
            If (e <> a And e <> b And e <> c And e <> d) Then
             For f = 1 To 8
              If (f <> a And f <> b And f <> c And f <> d And f <> e) Then
               For g = 1 To 8
                If (g <> a And g <> b And g <> c And g <> d And g <> e And g <> f) Then
                 For h = 1 To 8
                  If (h <> a And h <> b And h <> c And h <> d And h <> e And h <> f And h <> g) Then
                   Debug.Print Mid(moji, a, 1) + Mid(moji, b, 1) + Mid(moji, c, 1) + Mid(moji, d, 1) + Mid(moji, e, 1) + Mid(moji, f, 1) + Mid(moji, g, 1) + Mid(moji, h, 1)
                  End If
                 Next h
                End If
               Next g
              End If
             Next f
            End If
           Next e
          End If
         Next d
        End If
       Next c
      End If
     Next b
    Next a
End Sub

こちらに置いておきます→組み合わせを求める

http://q.hatena.ne.jp/1198487103

A列に1~10000までを入れるには、A1に1、A2に2をいれて、両方を選択した状態でドラッグします。

Sub test()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer

    j = 1
    k = 1

    For i = 1 To 10000

        l = Cells(i, 1).Value
        Cells(i, 1) = Null
        Cells(k, j).Value = l

        k = k + 1

        If (i Mod 20 = 0) Then
            j = j + 1
            If (j Mod 3 = 1) Then
                    j = 1
                Else
                    k = k - 20
            End If
        End If

    Next i

End Sub

いったん変数にセルの内容を入れて、元のセルを消し、
そして、代入先のセルに元のセルの値をコピー。

代入先のセルを求めるのに、他の回答者さんのように数式を使うのは苦手なので(^^;) 

手作業で同じ事を行うときに、頭の中でどうやって代入先のセルを求めるのかを考えて、

「下に20個すすんだら、1つ右へ。3つ右に進んだら、1列目にして、そうでなければ、20個上に戻す」

をプログラムで表してみました。あんまりスマートじゃないけど、自分はこっちのほうが好き(^^;)

あと、このプログラムで、セルの値を一時的に退避させる変数 l だけど、

もし、Dim で宣言するには、何型で宣言すればいいんでしょうか?(^^;)

こちらに置いておきます→Excelのセル間の値のコピー

前の記事の。
ソートして出すように。

Sub test()
        Dim a(5) As Integer
        Dim b(5) As Integer
        Dim i As Integer
        Dim j As Integer

        For i = 1 To 5
                Do
                        j = Int(Rnd(1) * 5) + 1
                Loop While (a(j) <> 0)
                a(j) = i
        Next i

        For i = 1 To 4
                b(a(i)) = a(i + 1)
        Next i
        b(a(5)) = a(1)

        Debug.Print "-----------"

        For i = 1 To 5
                Debug.Print (Str(i) + "に来た人は" + Str(b(i)) + "に行きましょう")
        Next i

        Debug.Print "-----------"
End Sub

こんがらがってきた。。。
ここに置いておきます→一筆書きの組み合わせをソート

http://q.hatena.ne.jp/1198167363
VBAを使うには、Excelから「ツール」→「マクロ」→「Visual Basic Editor」でプロジェクトの中の「Sheet1」をダブルクリックするとコードを記述するウィンドウが表示されます。

デバッグウィンドウを開くには、「表示」→「イミディエイト ウィンドウ」

最初、質問の内容が?だったんですが、回答されている方の内容で、ようやく質問の意味が理解できました(^^);

Sub test()

        Dim a(5) As Integer
        Dim i As Integer
        Dim j As Integer

        For i = 1 To 5
                Do
                        j = Int(Rnd(1) * 5) + 1
                Loop While (a(j) <> 0)
                a(j) = i
        Next i

        Debug.Print "-----------"

        For i = 1 To 4
                Debug.Print (Str(a(i)) + "->" + Str(a(i + 1)))
        Next i

        Debug.Print (Str(a(5)) + "->" + Str(a(1)))
        Debug.Print "-----------"

End Sub

一応、組み合わせは出来たかな?
表示が並んでないので、いったん配列に入れて、
ソートして出したほうがわかりやすいかも。。。

ここに置いときます。→一筆書きの組み合わせ

© 2011 simple blog いろいろ勉強中 Suffusion theme by Sayontan Sinha