Cells(a, b) = Int((8 * Rnd) + 1)
Next b
Next a
Dim c As Integer
For c = 1 To 10 ’询问是否对随机数满意
If (MsgBox("did u think the random are ok?", 260)) = vbYes Then
Cells(3, 1) = 1 '如果需要一个0或1的单元格给其它程序块使用
Exit Sub '满意就退出
Else '不满意就继续产生随机数
For a = 1 To 2
For b = 1 To 3
Cells(a, b) = Int((8 * Rnd) + 1)
Next b
Next a
Cells(3, 1) = 0
End If
Next c
MsgBox "if u want to continue rondom number press cmd1 again please"
End Sub
解答6简化一下:
Sub test()
Upper = 0
Bottom = 100
Do While Range("A1") <> 1
Range("E1") = Int(Rnd() * (Upper - Bottom + 1)) + Bottom
Response = MsgBox("Do you accept the number?", vbYesNo + vbDefaultButton2)
If Response = vbYes Then Range("A1") = 1
Loop
End Sub
排列组合
比如现在有一个 长度是9 位的字符串(ABCDEFGHI),想列出全部的只取其中7个字符的组合值:
CDEFGHI、ADEFGHI、ABEFGHI、ABCFGHI、ABCDGHI、……、共36个。用函数或VBA均可。
解答:Sub combination()
Dim a, b, c, d, e, f, g, h, i, j, k As Integer
Dim str As String
j=1
For a = 0 To 1
For b = 0 To 2 Step 2
For c = 0 To 3 Step 3
For d = 0 To 4 Step 4
For e = 0 To 5 Step 5
For f = 0 To 6 Step 6
For g = 0 To 7 Step 7
For h = 0 To 8 Step 8
For i = 0 To 9 Step 9
k = a / 1 + b / 2 + c / 3 + d / 4 + e / 5 + f / 6 + g / 7 + h / 8 + i / 9
If k = 7 Then
str = ""
If a <> 0 Then str = str & "A"
If b <> 0 Then str = str & "B"
If c <> 0 Then str = str & "C"
If d <> 0 Then str = str & "D"
If e <> 0 Then str = str & "E"
If f <> 0 Then str = str & "F"
If g <> 0 Then str = str & "G"
If h <> 0 Then str = str & "H"
If i <> 0 Then str = str & "I"
cells(j,1)=str
j=j+1
End If
Next i
Next h
Next g
Next f
Next e
Next d
Next c
Next b
Next a
End Sub
如用MID函数,修改一下以上程序可得到任意长度为9的字符串的任取7个字符的组合。
解答2:用公式的解:
=REPLACE(REPLACE($M$1,MIN(IF(ROW()<{9,16,22,27,31,34,36,37},{1,2,3,4,5,6,7,8})),1,""),ROW()+9-MIN(IF(ROW()<{9,16,22,27,31,34,36,37},{9,16,22,27,31,34,36,37})),1,"")
动态输入公式
例如: 输入新数据后 A1=1;A2=SUM(A1:A1)、输入新数据后 A1=1,A2=2;A3=SUM(A1:A2) 、输入新数据后 A1=1,A2=2,A3=3,A4=SUM(A1:A3) 、.... 、如何通过VBA 代码实现?
解答:假设你的表如下结构:共4列 、表头在第3行、起始列为第1列 、数据区从第4行开始 、请确保B1:B4为空 、A1:A4值为4 、在当前工作表的下面事件中做如下处理:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Row > Cells(1, .Column) Or .Column > 4 Then
.Value = ""
GoTo ex
End If
If Trim(Target) = "" Then
If Trim(.Offset(1, 0)) = "" Then
If .Row = 5 Then
.Offset(-1, 0) = ""
ElseIf .Row > 5 Then
.Offset(-1, 0) = "=SUM(" & .Offset(-1, 0).End(xlUp).Address(False, False, xlA1) & ":" & .Offset(-2, 0).Address(False, False, xlA1) & ")"
End If
End If
If .Offset(1, 0).HasFormula And .Row = 4 Then .Offset(1, 0) = ""
If Trim(.Offset(1, 0)) <> "" Then
.Delete Shift:=xlUp
Cells(1, ActiveCell.Column) = Cells(1, ActiveCell.Column) - 1
End If
ElseIf Trim(.Offset(1, 0)) = "" Or .Offset(1, 0).HasFormula Then
.Offset(1, 0) = "=SUM(" & .End(xlUp).Address(False, False, xlA1) & ":" & .Address(False, False, xlA1) & ")"
Cells(1, .Column) = Cells(1, .Column) + 1
End If
End With
ex:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
If .Rows.Count > 1 Or .Columns.Count > 1 Then ActiveCell.Select
If .Row < 3 And .Column < 5 Then Cells(4, ActiveCell.Column).Select
End With
End Sub
以上代码是按我理想的做的。
主要部分:
If Trim(.Offset(1, 0)) = "" Or .Offset(1, 0).HasFormula Then
.Offset(1, 0) = "=SUM(" & .End(xlUp).Address(False, False, xlA1) & ":" & .Address(False, False, xlA1) & ")"
Cells(1, .Column) = Cells(1, .Column) + 1