Excel VBA - 读书上网笔记

If Target = \

If Target.Address <> \Application.ScreenUpdating = False Dim Arr, i&, rng As Range

Cells.EntireRow.Hidden = False If Target = \全部\Arr = [a2].CurrentRegion For i = 3 To UBound(Arr)

If Arr(i, 2) <> Target.Value Then

If rng Is Nothing Then Set rng = Rows(i) Else Set rng = Union(rng, Rows(i)) End If Next

If Not rng Is Nothing Then rng.EntireRow.Hidden = True Application.ScreenUpdating = True End Sub

77，Getobject后的显示表格

在用With GetObject(myPath & myName)之后，会有不显示工作簿的情况发生，可用 Windows(myName).Visible = 1 显示。

78，导出图片（Export方法）:by:doitbest

‘2013-1-19

‘http://club.excelhome.net/thread-972129-1-1.html Sub abc()

Dim s As Shape, x As Range

For Each x In Range(\ For Each s In ActiveSheet.Shapes

If s.TopLeftCell.Address = x.Offset(-1, -1).Address Then s.CopyPicture

With ActiveSheet.ChartObjects.Add(0, 0, s.Width + 5, s.Height + 5).Chart .Paste

.Export ThisWorkbook.Path & \ .Parent.Delete End With End If Next Next End Sub

79，全排列

‘2012-1-19

‘http://www.excelpx.com/forum.php?mod=viewthread&tid=294149#pid3409245 Sub lqxs()

Dim Arr, i&, j&, x&, l&, pl$, nn, aa, bb, cc Dim d, k, Myr&

Set d = CreateObject(\Sheet1.Activate

Arr = [i6].CurrentRegion For i = 1 To UBound(Arr) pl = \

For j = 1 To Len(Arr(i, 1)) aa = Mid(Arr(i, 1), j, 1) For x = 1 To Len(Arr(i, 2)) bb = Mid(Arr(i, 2), x, 1) For l = 1 To Len(Arr(i, 3)) cc = Mid(Arr(i, 3), l, 1)

d(aa & \ Next Next Next

k = d.keys

For j = 0 To UBound(k)

pl = pl & qpl(k(j)) & \ Next

pl = Left(pl, Len(pl) - 1) nn = Split(pl, \

Myr = [a65536].End(xlUp).Row + 1

Cells(Myr, 1).Resize(UBound(nn) + 1, 1) = Application.Transpose(nn) d.RemoveAll Next End Sub

Function qpl(s)

mm = Split(s, \

qpl = mm(0) & mm(1) & mm(2) & \mm(0) & mm(2) & \mm(2) & mm(0) & mm(1)

End Function

Function qp(s) ‘3位数的全排列