我想運行宏。您可以在當(dāng)前工作表B3中填充公式。這個公式的結(jié)果是所有工作表中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中創(chuàng)建新工作表“表”

通過VBA編程可以輕松地添加新工作表，但不知道如何控制新表的名稱。新創(chuàng)建的工作表的名稱不具體，因此最好使用創(chuàng)建的新表

s

Ac='表'

3.使用VBA，表1中的列A可以與表2、3、4和5一起使用……。搜索與的列A相同的行，并將后一整行復(fù)制到表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頁保護(hù)頁)

A '{ } '，選擇True ' Checkbox框(鎖定項目以供查看) (選擇{ }，取消選擇{-})

A '{TAB} '，True 'TAB鍵(轉(zhuǎn)到第一次輸入密碼Textbox

MyPW='chijanzen ' '假設(shè)密碼chijanzen

輸入“A myPW，True”密碼

A '{TAB} '，True 'TAB鍵(轉(zhuǎn)到第二個密碼輸入Textbox)

輸入“A myPW，True”密碼

A '{ENTER} '，True '按鈕確認(rèn)按鈕(默認(rèn))

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

End Sub

5、氣泡排序方法之所以成為“氣泡排序”，是因為值小或輕的元素漂浮在不斷排序的組數(shù)的頂部。

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“輸入要對齊的數(shù)目：”

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

首先定義一個數(shù)組：通過循環(huán)錄入10個整數(shù)，然后用一個二重循環(huán)測試前一個數(shù)是否大于后一個數(shù)如果大于則交換兩個數(shù)的下標(biāo)，即交換兩個數(shù)在數(shù)組中的位置，交換通過一個變量來進(jìn)行

我先用傳統(tǒng)的方法解決這個問題，經(jīng)過比較，選用了較為簡單的和高效的排序方法

——“快速排序”，具體算法可參考數(shù)據(jù)結(jié)構(gòu)等有關(guān)書籍對所有數(shù)據(jù)排序后再合

并相同數(shù)據(jù)，合并程序較為簡便，我開始時采用了這種方法，但后來發(fā)現(xiàn)對于這些

的數(shù)據(jù)，先合并后排序速度更快，因為有大量相同的數(shù)據(jù)合并是采用“標(biāo)記”算

法，具體如下：（設(shè)數(shù)據(jù)已存放在sData()數(shù)組中 ，結(jié)果存到Queryp()數(shù)組，

Amount是數(shù)據(jù)個數(shù)）

'把相同元素置 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)

雖然這樣使得運算速度有所高，但是仍然要進(jìn)行大量的循環(huán)運算，占據(jù)了程序大部

分的運算時間于是我一直在尋覓一種更為高效的算法

功夫不負(fù)有心人，在仔細(xì)分析數(shù)據(jù)的特征，比較了多種方案之后，我終于找到了一

種相當(dāng)成功的算法，原來要3到4秒的運算縮短到僅需0.1到0.2秒

我遇到的數(shù)據(jù)具有以下特征：①相同數(shù)據(jù)很多，②最大、最小數(shù)之間相差不到3，

③都是帶兩位小數(shù)的正數(shù)

針對數(shù)據(jù)的特征，我采用了以下算法：

針對數(shù)據(jù)的特征，我采用了以下算法：

步驟：

1． 用一個循環(huán)找出整數(shù)和小數(shù)部分的最大、最小值小數(shù)部分的最大、最小值乘

以100轉(zhuǎn)為整數(shù)

2． 定義一個二維數(shù)組，下標(biāo)范圍分別是整數(shù)和小數(shù)部分的最小值到最大值

3． 再用一個循環(huán)把所有源數(shù)據(jù)填入剛才定義的二維數(shù)組，填寫規(guī)則是，源數(shù)據(jù)的

整數(shù)和小數(shù)部分分別對應(yīng)二維數(shù)組的兩個下標(biāo)例如，“13.51"填到“A(13,51)"

中

4． 最后順向或逆向讀取二維數(shù)組中的非零數(shù)據(jù)即可得到從小到大或從大到小排列

的數(shù)據(jù)，而且不會含有重復(fù)數(shù)據(jù)

用VB 編寫的程序如下：

'＊＊＊＊密集型數(shù)據(jù)處理＊＊＊＊

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()

'讀取數(shù)據(jù)

ReadData

IPmax = 0: IPmin = 1000

DPmax = 0: DPmin = 99

For i = 1 To Amount

' 找整數(shù)和小數(shù)部分的最大、最小值

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)

'填入數(shù)據(jù)

For i = 1 To Amount

IntegerPart = Int(sData(i))

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

DiffDataArray(IntegerPart, DecimalPart) = sData(i)

Next i

Next i

'提取數(shù)據(jù)

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)

該方法對于本人遇到的這種“密集型”數(shù)據(jù)最為有效，但是如果遇上“稀疏型”數(shù)

據(jù)，例如最大、最小值相差幾千，甚至上萬的數(shù)據(jù)，就沒什么優(yōu)勢了，而且會占用

較大的內(nèi)存

經(jīng)過改進(jìn)，我得到了處理稀疏型數(shù)據(jù)的高效算法高效的前提條件同樣是源數(shù)據(jù)具

有大量相同數(shù)據(jù)思路是在前一種方法的基礎(chǔ)上增加一個單維數(shù)組，用來保存整數(shù)

部分?jǐn)?shù)據(jù)，保存過程中用插入法對其進(jìn)行排序因為有大量重復(fù)數(shù)據(jù)，要排序的數(shù)

據(jù)量相對較少當(dāng)從二維數(shù)組中讀取數(shù)據(jù)時，用單維數(shù)組代入二維數(shù)組的第一個下

標(biāo)，具體代碼下：

'＊＊＊＊稀疏型數(shù)據(jù)處理＊＊＊＊

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()

'讀取數(shù)據(jù)

ReadData

IPmax = 0: IPmin = 1000

DPmax = 0: DPmin = 99

IPAamount = 0

For i = 1 To Amount

'獲取整數(shù)和小數(shù)部分的最大最小值

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

'對整數(shù)部分"IPArray()"進(jìn)行插入法排序 (從大到小）

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)

'填入數(shù)據(jù)

For i = 1 To Amount

IntegerPart = Int(sData(i))

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

DiffDataArray(IntegerPart, DecimalPart) = sData(i)

Next i

'提取數(shù)據(jù)

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)

具體采用哪種算法，要看數(shù)據(jù)的性質(zhì)而定，以下是本人的一些實測數(shù)據(jù)，僅供參考

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

自動隱藏表格中無數(shù)據(jù)的行

表1 是數(shù)據(jù)源，經(jīng)常改變；

表2 引用表1 中某列有數(shù)據(jù)的單元格（利用動態(tài)位址已實現(xiàn)）

由于表1 的改變，表2 的大小隨之而變

問題：如何實現(xiàn)表2 中沒有數(shù)據(jù)的行（有公式）自動隱藏？謝謝賜教！

Sub abc()

For i = 1 To 300

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

Next i

End Sub

你寫的語句可以解決隱藏的問題，可是如果我執(zhí)行了它之后，再在表1中增加數(shù)據(jù)，表2不會自動顯示有了數(shù)據(jù)的行如何修改？

將此宏設(shè)為自動運行（打開文件時）

Sub abc()

For i = 1 To 300

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

Next i

End Sub

用VBA如何自動合并列的內(nèi)容？

用VBA如何自動合并列的內(nèi)容？

To hongjian ：

Sub MergeTest()

For i = 3 To 30

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

Next

End Sub