| |
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007):
* 아래줄에 질문을 작성하세요 >>
첨부파일 참조
==============[도시남자님 글에 대한 답변입니다]==============
첨무화일 참조하세요...
Sub CreateRandom()
Dim wstAct As Worksheet, wstStorage As Worksheet
Dim rTg As Range
Dim rSData As Range
Dim rFind As Range, sAddr As String
Dim lRow As Long
Dim iX As Integer, iNo As Integer, iCount As Integer
Dim bFlg As Boolean
Dim oLst As Object, vX
Const iUBound As Integer = 45
Const iLBound As Integer = 1
Set wstAct = Worksheets("Sheet1")
Set rTg = wstAct.Range("B7")
rTg.Resize(30, 6).ClearContents ' 기존자료 지우기
Set wstStorage = Worksheets("StorageData")
Set oLst = CreateObject("System.Collections.ArrayList")
Do
oLst.Clear ' 오브젝트 초기화
' 난수 6개 생성
Do
Randomize
vX = Int((iUBound - iLBound + 1) * Rnd + iLBound)
If Not oLst.Contains(vX) Then oLst.Add vX
Loop While oLst.Count < 6
oLst.Sort
' 기존자료에 존재여부 확인
Set rFind = wstStorage.Columns(1).Find(What:=oLst(0), LookAt:=xlWhole)
If Not rFind Is Nothing Then
sAddr = rFind.Address
Do
For iX = 1 To oLst.Count - 1
If oLst(iX) = rFind.Cells(1, iX + 1) Then
bFlg = True
Else
bFlg = False
Exit For
End If
Next
If bFlg Then Exit Do
Set rFind = wstStorage.Columns(1).FindNext(rFind)
Loop While Not rFind Is Nothing And rFind.Address <> sAddr
Else
bFlg = False
End If
If bFlg = False Then
iNo = iNo + 1
vX = oLst.ToArray
rTg.Cells(iNo, 1).Resize(1, oLst.Count) = vX
getRowCell(wstStorage).Resize(1, oLst.Count) = vX '임시보관 데이터에 저장
End If
iCount = iCount + 1
Loop While iNo < 30
Set oLst = Nothing
wstStorage.Visible = xlSheetVeryHidden
End Sub
Function getRowCell(wst As Worksheet)
Set getRowCell = wst.Cells(Rows.Count, 1).End(xlUp)
If getRowCell <> "" Then Set getRowCell = getRowCell.Offset(1)
End Function
Sub ClearStorageData()
With Worksheets("StorageData")
.Cells.Clear
.Visible = xlSheetVeryHidden
MsgBox "임시 보관된 난수 조합을 삭제하였습니다.", vbInformation, "임시보관Clear //// DewDrop"
End With
End Sub
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
