•新手,求问VB6的编程问题
我菜鸟什么都不懂(不知什么时侯才学懂),请神人在每句能详细解释,因我菜鸟什么都不懂。Sub DataSplit()
m = Sheet1.[a1].End(4).Row
arr = Sheet1.[c1].Resize(m, 5)
ReDim brr(2 To m, 1 To 11)
For i = 2 To m
For j = 1 To 5
t = arr(i, j)
brr(i, t) = t
Next
Next
Sheet1.[h2].Resize(m - 1, 11) = brr
End Sub
Sub kagawa()
Dim i&, j&, k&, h&, m&, n&, Ac&, r&, s$, t, cnt&
tms = Timer
m = 11: n = 8: Ac8 = (m, n)
ReDim Combin8&(1 To Ac8, 1 To m)
Call GetCombinArr(Combin8, m, n)
Sheet1.Activate
m = Sheet1.[a1].End(4).Row
arr = Sheet1.[c1].Resize(m, 5)
' Sheet2.Activate
ReDim brr&(2 To m, 1 To 5)
For i = 2 To m
For j = 1 To 5
brr(i, j) = arr(i, j)
Next
Next
ReDim crr(1 To Ac8, 1 To m)
For k = 1 To Ac8
cnt = 0
For i = 2 To m
r = 0
For j = 1 To 5
r = r + Combin8(k, brr(i, j))
Next
If r = 5 Then crr(k, i) = i: cnt = cnt + 1
Next
crr(k, 1) = cnt
Next
With Sheet2
.[a1].CurrentRegion.AutoFilter
.[a1].CurrentRegion.Offset(1, 9) = ""
.[k2].Resize(Ac8, m) = crr
.Cells(1, 10) = "result"
.Cells(1, 11) = "cnt"
For i = 2 To m
.Cells(1, i + 10) = "s" & i
Next
End With
ReDim drr(1 To Ac8, 0 To 1)
For i = 1 To Ac8
drr(i, 1) = 1
Next
ReDim frr(2 To m) As Boolean
Randomize
h = m - 1
k = 0
Do
cnt = 1
For i = 1 To Ac8
If drr(i, 1) > 0 Then
r = 0
For j = 2 To m
If Not frr(j) Then If crr(i, j) Then r = r + 1
Next
If r Then drr(i, 1) = r Else drr(i, 1) = ""
If r = cnt Then s = s & "," & i Else If r > cnt Then cnt = r: s = i
End If
Next
t = Split(s, ",")
r = t(Int(Rnd * (UBound(t) + 1)))
cnt = 0
For j = 2 To m
If Not frr(j) Then If crr(r, j) Then frr(j) = True: cnt = cnt + 1
Next
drr(r, 0) = cnt
drr(r, 1) = ""
h = h - cnt
k = k + 1
Loop While h
With Sheet2
.[j2].Resize(Ac8) = drr
.[a1].AutoFilter Field:=10, Criteria1:="<>"
.[i1].Resize(Ac8, 3).SpecialCells(xlCellTypeVisible).Copy
End With
' Sheet1.Activate
Sheet1.[j1].CurrentRegion = ""
Sheet1.[j1].PasteSpecial Paste:=xlPasteValues
MsgBox Format(Timer - tms, "0.000s ") & k
End Sub
Sub GetCombinArr(arr&(), m&, n&)
Dim i&, j&, l&
ReDim a&(1 To n)
a(1) = 0: a(n) = m: j = 1
For i = 1 To (m, n)
If a(n) = m Then
a(j) = a(j) + 1
If a(j) < m - n + j Then
For j = j To n - 1
a(j + 1) = a(j) + 1
Next
End If
j = j - 1
Else
a(n) = a(n) + 1
End If
For l = 1 To n
arr(i, a(l)) = 1
Next
Next
End Sub
模块2--------------------------------------------------------模块2
Sub Macro2()
Range("I1:K166").SpecialCells(xlCellTypeVisible).Copy
Selection.PasteSpecial Paste:=xlPasteValues
End Sub
Sub Macro3()
'
' Macro3 Macro
' Macro recorded 2013/5/22 by NWP18
'
'
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
End Sub
[ 本帖最后由 warosng 于 2013-10-6 20:28 编辑 ]