Snasui Excel Forum

Code: Select all

Dim rall As Range, iCount As Integer
With Sheets("ข้อมูล")
    Set rall = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    iCount = rall.Count
End With
Select Case Sheets("random").Range("a3")
    Case "หัวข้อ1"
        Sheets("random").Range("b3").Value = Application.Index(rall, Int(Rnd * iCount) + 1)
    Case "หัวข้อ2"
        Sheets("random").Range("b3").Value = Application.Index(rall.Offset(0, 1), Int(Rnd * iCount) + 1)
    Case "หัวข้อ3"
        Sheets("random").Range("b3").Value = Application.Index(rall.Offset(0, 2), Int(Rnd * iCount) + 1)
    Case "หัวข้อ4"
        Sheets("random").Range("b3").Value = Application.Index(rall.Offset(0, 3), Int(Rnd * iCount) + 1)
End Select

Code: Select all

Case "mm"
    Sheets("sheet3").Range("c3").Value = Application.Index(rall, Int(Rnd * iCount) + 1)
    Do While Sheets("Sheet3").Range("d3").Value = Sheets("Sheet3").Range("c3").Value
        Sheets("sheet3").Range("d3").Value = Application.Index(rall, Int(Rnd * iCount) + 1)
    Loop

Code: Select all

Sub test()
    Dim prjs As Range, prj As Range, pjl As Integer
    Dim pa As Range, paCheck As Range, pck As Range
    Dim cmAll As Range, cm As Range, cmr As Range, c As Range
    Dim grpAll As Range, gSl() As Variant, gc As Integer
    Dim gt As Range, g As Range, iCount As Integer, i As Integer
    Dim ig As Integer, t As String, x As String
    With Sheets("Sheet2")
        Set pa = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
        Set grpAll = .Range("f1", .Range("f1").End(xlToRight))
    End With
    With Sheets("Sheet3")
        Set paCheck = .Range("a3", .Range("a" & .Rows.Count).End(xlUp))
    End With
    For Each pck In paCheck
        pjl = Application.Match(pck, pa, 0)
        Set cmAll = pa.Offset(pjl - 1, 1).Resize(1, 2)
        gc = Application.Match(pck.Offset(0, 1), grpAll, 0)
        Set gt = Range(grpAll.Offset(1, gc - 1), grpAll.Offset(1, gc - 1) _
            .End(xlDown)).Resize(, 1)
        iCount = 0
        For Each g In gt
            If Application.CountIf(cmAll, g) = 0 Then
                ReDim Preserve gSl(iCount)
                gSl(iCount) = g
                iCount = iCount + 1
            End If
        Next g
        Set cmr = pck.Offset(0, 2).Resize(1, 2)
        t = ""
        i = 0
        For Each c In cmr
            Do While i <= 1
                x = gSl(Int(Rnd * (UBound(gSl) + 1)))
                If InStr(t, x) = 0 Then
                    t = t & x
                    c.Offset(0, i) = x
                    i = i + 1
                End If
            Loop
        Next c
    Next pck
End Sub