表格怎么增加宏看这里!Excel常用宏技巧九

我想运行宏。您可以在当前工作表B3中填充公式。这个公式的结果是所有工作表中B4单元格的总和。这个宏该怎么写？

Sub gg()

Dim sh As Worksheet、shname$

For Each sh In Worksheets

Shname=

交流(' B3 ')。value=AC ('B3 ')。valueworksheets (sh name)。范围(' B4 ')

next

End Sub

2、如何在VBA中创建新工作表“表”

通过VBA编程可以轻松地添加新工作表，但不知道如何控制新表的名称。新创建的工作表的名称不具体，因此最好使用创建的新表

s

Ac='表'

3.使用VBA，表1中的列A可以与表2、3、4和5一起使用……。搜索与的列A相同的行，并将后一整行复制到表1中检索到的行中。

Sub Copy1()

Dimrow _ dn1、row _ dnn、I、j和n as integer

Row _ dn1=s ('a65536 ')。end (xlup)。row

K=1: n=1

For Each wSheet In Ac

With wSheet

中频。Name 'Sheet1' Then

Row _ dnn=。range ('a65536 ')。end (xlup)。row

For I=2 To Row_dn1

For j=2 To Row_dnN

中频。Cells(j，1)=S(i，1) Then

.rows (j' :' j)。copy destination :=s(row _ dn1 n ' : ' row _ dn1n)

N=n 1

End If

next j。

Next I

End If

End With

Next wSheet

End Sub

4、如果要使用VBA程序输入密码，请使用以下代码

Sub EnterNewPW()

程序说明使用： SendKey输入VBA工程密码

注：要运行此程序，必须在Excel窗口中，而不是在VBE窗口中

A '%{F11} '，True 'Alt切换到F11 VBA窗口

A '%T '，True 'ALT T工具(繁体中文为(T))

A 'e '，True '工具(T)-VBproject属性(e)

A' {tab} '，true' tab键(切换到第2页保护页)

A '{ } '，选择True ' Checkbox框(锁定项目以供查看) (选择{ }，取消选择{-})

A '{TAB} '，True 'TAB键(转到第一次输入密码Textbox

MyPW='chijanzen ' '假设密码chijanzen

输入“A myPW，True”密码

A '{TAB} '，True 'TAB键(转到第二个密码输入Textbox)

输入“A myPW，True”密码

A '{ENTER} '，True '按钮确认按钮(默认)

a“% { F11 }”，“True”将返回到Excel窗口

End Sub

5、气泡排序方法之所以成为“气泡排序”，是因为值小或轻的元素漂浮在不断排序的组数的顶部。

Sub Macro1()

Dim I As Integer

Dim j As Integer

Dim t as integer

Static number (1至10) as integer

For I=1到10

Number(i)=inputbox“输入要对齐的数目：”

Next I

For I=10To 2 Step -1

for j=1 to I1

交换下面的位置

If number(j) > number(j + 1) Then

t = number(j + 1)

number(j + 1) = number(j)

number(j) = t

End If

Next j

Next i

For i = 1 To 20

Print number(i)

Next i

End sub

首先定义一个数组：通过循环录入10个整数，然后用一个二重循环测试前一个数是否大于后一个数如果大于则交换两个数的下标，即交换两个数在数组中的位置，交换通过一个变量来进行

我先用传统的方法解决这个问题，经过比较，选用了较为简单的和高效的排序方法

——“快速排序”，具体算法可参考数据结构等有关书籍对所有数据排序后再合

并相同数据，合并程序较为简便，我开始时采用了这种方法，但后来发现对于这些

的数据，先合并后排序速度更快，因为有大量相同的数据合并是采用“标记”算

法，具体如下：（设数据已存放在sData()数组中 ，结果存到Queryp()数组，

Amount是数据个数）

'把相同元素置 0

For i = 1 To Amount

If sData(i) <> 0 Then

For j = i ＋ 1 To Amount

If sData(i) = sData(j) Then sData(j) = 0

Next j

End If

Next i

'删除相同元素

Queryp(1) = sData(1)

k = 1

For i = 2 To Amount

If Not (sData(i) = 0) Then

k = k ＋ 1

Queryp(k) = sData(i)

End If

Next i

kMax = k

ReDim Preserve Queryp(kMax)

虽然这样使得运算速度有所高，但是仍然要进行大量的循环运算，占据了程序大部

分的运算时间于是我一直在寻觅一种更为高效的算法

功夫不负有心人，在仔细分析数据的特征，比较了多种方案之后，我终于找到了一

种相当成功的算法，原来要3到4秒的运算缩短到仅需0.1到0.2秒

我遇到的数据具有以下特征：①相同数据很多，②最大、最小数之间相差不到3，

③都是带两位小数的正数

针对数据的特征，我采用了以下算法：

针对数据的特征，我采用了以下算法：

步骤：

1． 用一个循环找出整数和小数部分的最大、最小值小数部分的最大、最小值乘

以100转为整数

2． 定义一个二维数组，下标范围分别是整数和小数部分的最小值到最大值

3． 再用一个循环把所有源数据填入刚才定义的二维数组，填写规则是，源数据的

整数和小数部分分别对应二维数组的两个下标例如，“13.51"填到“A(13,51)"

中

4． 最后顺向或逆向读取二维数组中的非零数据即可得到从小到大或从大到小排列

的数据，而且不会含有重复数据

用VB 编写的程序如下：

'＊＊＊＊密集型数据处理＊＊＊＊

Dim i As Long, j As Long, k As Long, kMax As Long

Dim Queryp() As Single

ReDim Queryp(Amount)

Dim IntegerPart As Integer, DecimalPart As Integer

Dim IPmax As Integer, IPmin As Integer

Dim DPmax As Integer, DPmin As Integer

Dim DiffDataArray()

'读取数据

ReadData

IPmax = 0: IPmin = 1000

DPmax = 0: DPmin = 99

For i = 1 To Amount

' 找整数和小数部分的最大、最小值

IntegerPart = Int(sData(i))

DecimalPart = (sData(i) － IntegerPart) ＊ 100

If IntegerPart > IPmax Then

IPmax = IntegerPart

ElseIf IntegerPart < IPmin Then

IPmin = IntegerPart

End If

If DecimalPart > DPmax Then

DPmax = DecimalPart

ElseIf DecimalPart < DPmin Then

DPmin = DecimalPart

End If

Next i

ReDim DiffDataArray(IPmin To IPmax, DPmin To DPmax)

'填入数据

For i = 1 To Amount

IntegerPart = Int(sData(i))

DecimalPart = (sData(i) － IntegerPart) ＊ 100

DiffDataArray(IntegerPart, DecimalPart) = sData(i)

Next i

Next i

'提取数据

k = 0

For i = IPmax To IPmin Step －1

For j = DPmax To DPmin Step －1

If DiffDataArray(i, j) <> 0 Then

k = k ＋ 1

Queryp(k) = DiffDataArray(i, j)

End If

Next j

Next i

kMax = k

ReDim Preserve Queryp(kMax)

该方法对于本人遇到的这种“密集型”数据最为有效，但是如果遇上“稀疏型”数

据，例如最大、最小值相差几千，甚至上万的数据，就没什么优势了，而且会占用

较大的内存

经过改进，我得到了处理稀疏型数据的高效算法高效的前提条件同样是源数据具

有大量相同数据思路是在前一种方法的基础上增加一个单维数组，用来保存整数

部分数据，保存过程中用插入法对其进行排序因为有大量重复数据，要排序的数

据量相对较少当从二维数组中读取数据时，用单维数组代入二维数组的第一个下

标，具体代码下：

'＊＊＊＊稀疏型数据处理＊＊＊＊

Dim i As Long, j As Long, k As Long, kMax As Long

Dim Queryp() As Single

ReDim Queryp(Amount)

Dim IntegerPart As Integer, DecimalPart As Integer

Dim IPmax As Integer, IPmin As Integer

Dim DPmax As Integer, DPmin As Integer

Dim IPArray() As Integer, IPAamount As Integer

ReDim IPArray(Amount)

Dim DiffDataArray()

'读取数据

ReadData

IPmax = 0: IPmin = 1000

DPmax = 0: DPmin = 99

IPAamount = 0

For i = 1 To Amount

'获取整数和小数部分的最大最小值

IntegerPart = Int(sData(i))

DecimalPart = (sData(i) － IntegerPart) ＊ 100

If IntegerPart > IPmax Then

IPmax = IntegerPart

ElseIf IntegerPart < IPmin Then

IPmin = IntegerPart

IPmin = IntegerPart

End If

If DecimalPart > DPmax Then

DPmax = DecimalPart

ElseIf DecimalPart < DPmin Then

DPmin = DecimalPart

End If

'对整数部分"IPArray()"进行插入法排序 (从大到小）

For j = 1 To IPAamount

If IntegerPart > IPArray(j) Then

IPAamount = IPAamount ＋ 1

For k = IPAamount To j ＋ 1 Step －1

IPArray(k) = IPArray(k － 1)

Next k

IPArray(j) = IntegerPart

Exit For

ElseIf IntegerPart = IPArray(j) Then

Exit For

End If

Next j

If j > IPAamount Then

IPAamount = IPAamount ＋ 1

IPArray(IPAamount) = IntegerPart

End If

Next i

ReDim DiffDataArray(IPmin To IPmax, DPmin To DPmax)

'填入数据

For i = 1 To Amount

IntegerPart = Int(sData(i))

DecimalPart = (sData(i) － IntegerPart) ＊ 100

DiffDataArray(IntegerPart, DecimalPart) = sData(i)

Next i

'提取数据

k = 0

For i = 1 To IPAamount

For j = DPmax To DPmin Step －1

If DiffDataArray(IPArray(i), j) <> 0 Then

k = k ＋ 1

Queryp(k) = DiffDataArray(IPArray

（i), j)

End If

Next j

Next i

kMax = k

ReDim Preserve Queryp(kMax)

k

ReDim Preserve Queryp(kMax)

具体采用哪种算法，要看数据的性质而定，以下是本人的一些实测数据，仅供参考

如果你有更好的方法，可不要忘记和朋友们分享哦

自动隐藏表格中无数据的行

表1 是数据源，经常改变；

表2 引用表1 中某列有数据的单元格（利用动态位址已实现）

由于表1 的改变，表2 的大小随之而变

问题：如何实现表2 中没有数据的行（有公式）自动隐藏？谢谢赐教！

Sub abc()

For i = 1 To 300

If Cells(i, 1).value = "" Then Rows(i).Hidden = True

Next i

End Sub

你写的语句可以解决隐藏的问题，可是如果我执行了它之后，再在表1中增加数据，表2不会自动显示有了数据的行如何修改？

将此宏设为自动运行（打开文件时）

Sub abc()

For i = 1 To 300

If Cells(i, 1).value <>"" Then Rows(i).Hidden = false

Next i

End Sub

用VBA如何自动合并列的内容？

用VBA如何自动合并列的内容？

To hongjian ：

Sub MergeTest()

For i = 3 To 30

Cells(i, 3) = Cells(i, 1) & Chr(10) & Cells(i, 2)

Next

End Sub