| |
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007):
* 아래줄에 질문을 작성하세요 >>
첨부파일 참조
==============[도시남자님 글에 대한 답변입니다]==============
아래 같이 수정하세요.
Sub CreateRandom()
Dim wstAct As Worksheet, wstStorage As Worksheet
Dim rTg As Range, rFind As Range
Dim iNo As Integer
Dim oLst As Object
Dim vX, vArray
Const iLBound As Integer = 1 ' 난수 하한값
Const iUBound As Integer = 45 ' 난수 상한값
Const iCol As Integer = 6 ' 난수생성갯수
Call SpeedOn(True)
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
' 난수 6개 생성
Do
Randomize
vX = Int((iUBound - iLBound + 1) * Rnd + iLBound)
If Not oLst.Contains(vX) Then oLst.Add vX
Loop While oLst.Count < iCol
oLst.Sort
vArray = oLst.ToArray
oLst.Clear ' 오브젝트 초기화
' 기존자료에 존재여부 확인
Set rFind = wstStorage.Columns(iCol + 1).Find(What:=Join(vArray), LookAt:=xlWhole)
If rFind Is Nothing Then
iNo = iNo + 1
rTg.Cells(iNo, 1).Resize(1, iCol) = vArray
With getRowCell(wstStorage) '임시보관 데이터에 저장
.Resize(1, iCol).Value = vArray
.Cells(1, iCol + 1) = Join(vArray)
End With
End If
Loop While iNo < 30
Set oLst = Nothing
Call SpeedOn(False)
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
Sub SpeedOn(Optional blnX As Boolean = True)
With Application
.ScreenUpdating = Not blnX
.EnableEvents = Not blnX
.Calculation = IIf(blnX, xlCalculationManual, xlCalculationAutomatic)
.DisplayAlerts = Not blnX
End With
End Sub
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
