Excel VBA宏编程

当文案小妹向你抱怨Excel函数不够用，某些特殊操作虽然简单但繁琐重复，那么。。。是时候展现真正的技术了

 

先推荐个比较好的文档

http://wenku.baidu.com/link?url=TWBeg6Am-XbRBEF-jnRdjyqFrkA9s66H51dm8gZLWZmFyv8r77pmP-hj-kkpSAm1OVToSxp3OWj6N_Yh_dIo8kMmvfy1WAnHD08SNWNAKnu

 

 

阉割版的年月日生成

 

Sub GetID()

 

Dim str As String

 

For I = 2 To 5001

 

str = Worksheets(1).Cells(I, 13)

 

Worksheets(1).Cells(I, 14) = Mid(str, 7, 4) + "年"

 

Worksheets(1).Cells(I, 15) = "'" + Mid(str, 11, 2) + "月" + Mid(str, 13, 2) + "日"

 

Next

 

End Sub

 

MID相当于C#中的sudString，字符串截取，参数含义也和c#中一样

 

Sub GetID()

 

Dim str As String

 

For I = 2 To 5001

 

str = Worksheets(4).Cells(Int((20 * Rnd) + 1), 1)

 

Worksheets(1).Cells(I, 25) = str

 

Next

 

End Sub

 

Int((20 * Rnd) + 1)相当于获取1-20之间的任意整数

 

Sub randName()

 

Dim randomIndex As Integer

Dim name As String

Dim id As String

 

Dim randomIndex2 As Integer

 

For i = 1 To 500

 

randomIndex = Int(1001 * Rnd + 2)

name = Worksheets(1).Cells(randomIndex, 3)

id = Worksheets(1).Cells(randomIndex, 2)

 

randomIndex2 = Int((5001 - 2001 + 1) * Rnd + 2001)

Worksheets(1).Cells(randomIndex2, 23) = name

Worksheets(1).Cells(randomIndex2, 24) = id

 

Next

 

End Sub

 

为了生成某个范围内的随机整数，可使用以下公式：

Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

 

Sub Asd()

For I = 2 To 5001

Worksheets(1).Cells(I, 16) = Int(650 * Rnd + 50) * 100

Next

End Sub

 

 

随机某地车牌子

Sub awwa()

 

'temp用来随机，几种任意的车牌照组合，因为有最多两个字母一说、、、

Dim temp As Integer

Dim arr()

Dim arr2()

 

arr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0")

arr2 = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")

 

'车牌照五位

Dim a1 As String

Dim a2 As String

Dim a3 As String

Dim a4 As String

Dim a5 As String

 

For i = 2 To 5001

 

temp = Int(3 * Rnd + 1)

 

Select Case temp

'前两位有可能有字母

Case 1

a1 = arr(Int(35 * Rnd + 1))

a2 = arr2(Int(25 * Rnd + 1))

a3 = Int(9 * Rnd)

a4 = Int(9 * Rnd)

a5 = Int(9 * Rnd)

'2,4有可能为字母

Case 2

a1 = Int(9 * Rnd)

a2 = arr2(Int(25 * Rnd + 1))

a3 = Int(9 * Rnd)

a4 = arr(Int(35 * Rnd + 1))

a5 = Int(9 * Rnd)

'3，5可能为字母

Case 3

a1 = Int(9 * Rnd)

a2 = Int(9 * Rnd)

a3 = arr2(Int(25 * Rnd + 1))

a4 = Int(9 * Rnd)

a5 = arr(Int(35 * Rnd + 1))

End Select

 

Worksheets(1).Cells(i, 4) = "辽A" + a1 + a2 + a3 + a4 + a5

 

Next

 

'MsgBox arr(0)

 

End Sub

 

判断语句的写法

 

Sub asd()

 

If Worksheets(3).Cells(1, 6) = "" Then

 

MsgBox ("单元格为空")

 

Else

 

MsgBox ("单元格有值")

 

End If

 

End Sub

 

//==

 

Sub ss()

Dim mit As Integer

Dim ZooTemp As Integer

Dim R As Integer

 

mit = 1

zoomit = 0

zoomtemp = 1

 

Dim ZooIndex As Integer

Dim IBooIndex As Integer

 

ZooIndex = 1

IBooIndex = 1

 

For I = 0 To 199

 

R = Int(Rnd * 8 + 2)

zoomtemp = mit + R

For j = 1 To 10

 

mit = mit + 1

'MsgBox (Str(mit) & (" ") & Str(zoomtemp))

If (zoomtemp = mit) Then

'MsgBox ("已存入200人列表")

Worksheets(4).Cells(ZooIndex, 1) = Worksheets(3).Cells(mit, 1)

Worksheets(4).Cells(ZooIndex, 2) = Worksheets(3).Cells(mit, 2)

Worksheets(4).Cells(ZooIndex, 3) = Worksheets(3).Cells(mit, 3)

Worksheets(4).Cells(ZooIndex, 4) = Worksheets(3).Cells(mit, 4)

Worksheets(4).Cells(ZooIndex, 5) = Worksheets(3).Cells(mit, 5)

ZooIndex = ZooIndex + 1

Else

'MsgBox ("已存入1800人列表")

Worksheets(5).Cells(IBooIndex, 1) = Worksheets(3).Cells(mit, 1)

Worksheets(5).Cells(IBooIndex, 2) = Worksheets(3).Cells(mit, 2)

Worksheets(5).Cells(IBooIndex, 3) = Worksheets(3).Cells(mit, 3)

Worksheets(5).Cells(IBooIndex, 4) = Worksheets(3).Cells(mit, 4)

Worksheets(5).Cells(IBooIndex, 5) = Worksheets(3).Cells(mit, 5)

IBooIndex = IBooIndex + 1

End If

Next

 

Next

 

'MsgBox (Str(ZooIndex) & (" ") & Str(IBooIndex))

 

End Sub

 

//从5000里随机选2000个

 

Sub asd()

 

Dim r As Integer

 

r = 3

 

For i = 2 To 2001

r = Int(Rnd * 3 + 1) + r

Worksheets(3).Cells(i, 1) = Worksheets(2).Cells(r, 1)

Worksheets(3).Cells(i, 2) = Worksheets(2).Cells(r, 2)

Worksheets(3).Cells(i, 3) = Worksheets(2).Cells(r, 3)

Worksheets(3).Cells(i, 4) = Worksheets(2).Cells(r, 4)

Worksheets(3).Cells(i, 5) = Worksheets(2).Cells(r, 5)

Next

 

End Sub