VBA学习第十课笔记和代码

VBA学习第十课笔记和代码：

一、知识点：

1、单元格区域的复制方法

Sub 单元格对象的复制方法()

'单元格对象的复制方法，就是单元格区域.copy --- 目标区域的起始位置

Dim 主区域As Range, 被复制区域As Range

Set 主区域= Range("a1").CurrentRegion

Set 被复制区域= Range("a1").Resize(1, 主区域.Columns.Count)

With Sheet2

被复制区域.Copy .[a1]

End With

'被复制区域.Copy Sheet2.[a1]

End Sub

2、'单元格区域的交集，两块（或者更多）单元格区域之间共有的部分

'Intersect (区域1，区域2，...)

'返回一个单元格区域对象，是上面多块区域共有的部分

'如果区域2 是区域1的子集的话，就返回子集自身

'如果两个区域之间没有共有部分的话，则返回一个nothing

Sub 单元格对象求交集()

Dim 区域1 As Range, 区域2 As Range, 交集As Range

Sheet3.Activate

Set 区域1 = Range("a1").CurrentRegion

Set 区域2 = Range("e13:g16")

'Set 区域2 = [i2].CurrentRegion

Set 交集= Intersect(区域1, 区域2)

If Not 交集Is Nothing Then _

交集.Interior.Color = vbRed

End Sub

3、'求单元格的并集,万能胶水效应

'Union (区域1，区域2, ...)

'With 语句后面跟一个对象，工作表对象，工作簿对象

'For Each in 循环

Sub Union与With()

Sheet3.Activate

With Union([a1].CurrentRegion, [i3].CurrentRegion)

.Interior.Color = xlNone

.Font.Bold = True

.Font.Size = 10

.Font.ColorIndex = 4

End With

End Sub

二、作业：

Sub 查找王心刚()

Dim rng As Range, rng1 As Range, r As Range, i As Long

Sheet1.Activate

Set rng = Range("a1").CurrentRegion

Set rng1 = Intersect(Range("a1").CurrentRegion, Columns("d"))

edRange.Clear

Intersect(Range("a1").EntireRow, rng).Copy Sheet2.[a1]

For Each r In rng1

i = Sheet2.Range("a55366").End(xlUp).Row + 1

If r.Value = "王心刚" Then Intersect(r.EntireRow, rng).Copy Sheet2.Cells(i, 1) Next

End Sub

第二种方法：

Sub 使用交集办法查找王心刚()

Dim 筛选区域As Range, i As Long, 首地址As String, 目标地址As Range

Sheet2.Range("a1").CurrentRegion.Delete

Range("a1").Resize(1, Range("a1").CurrentRegion.Columns.Count).Copy Sheet2.[a1] '复制第一行

Set 筛选区域= Intersect(Range("a1").CurrentRegion, Range("D:D")).Find("王心刚") '查找两个地址交集中的首个王心刚

If Not 筛选区域Is Nothing Then

'如果筛选区域不是空(找到王心刚)向下运行

首地址= 筛选区域.Address

'获取首个王心刚的单元格地址

Set 目标地址= Intersect(Range("a1").CurrentRegion, 筛选区域.EntireRow) 目标地址.Copy Sheet2.Cells(2, 1)

'复制首个王心刚的行

Do

Set 筛选区域= Intersect(Range("a1").CurrentRegion, Range("D:D")).FindNext(筛选区域) '在两个地址交集中查下一个王心则

If 筛选区域.Address <> 首地址Then

i = Sheet2.Range("a1").End(xlDown).Row + 1

'动态获取行

Set 目标地址= Intersect(Range("a1").CurrentRegion, 筛选区

域.EntireRow)

目标地址.Copy Sheet2.Cells(i, 1)

Else

Exit Do

End If

Loop

End If

End Sub

2、Sub 天使水果统计()

Dim rng As Range, 首地址As String

Set rng = edRange.Find("南部")

首地址= rng.Address

rng.Offset(-1, 0).Resize(5, 4).Copy Sheet6.[a3]

Range("a3") = "合计"

Do

Set rng = edRange.FindNext(rng)

If rng.Address <> 首地址Then

rng.Offset(0, 1).Resize(4, 3).Copy

Sheet6.Range("a3").Offset(1, 1).PasteSpecial , Paste:=xlPasteAll, Operation:=xlAdd

Else

Exit Do

End If

Loop

End Sub

Sub 天使之城水果统计()

Dim rng As Range, i As Long, 首地址As String, 查找区域As Range, 目标区域As Range

Range("a3").CurrentRegion.Copy Sheets("统计表").Range("a3")

Sheets("统计表").Range("a3") = "统计"

Set 查找区域= Range("A:A").Find("南部")

首地址= 查找区域.Address

Do

Set 查找区域= Range("A:A").FindNext(查找区域)

If 查找区域.Address <> 首地址Then

查找区域.Offset(0, 1).Resize(4, 3).Copy