|
今天就帶大家利用這套教材的內(nèi)容完成一個稍微復(fù)雜的程序制作，需求如下： 1．首先用戶要和計算機進行對話，用戶將錄入一個人名的數(shù)據(jù) 2．VBA程序要根據(jù)用戶的需求，在工作'數(shù)據(jù)1'的工作表中進行A列的完全匹配查找（為了減少篇幅，我設(shè)定是唯一的值） 3．找到數(shù)據(jù)后，要把數(shù)據(jù)導(dǎo)出到一個文本文件，反饋給用戶。 上述的過程其實是很多地方大家都會看到的，或者有這類程序的影子，只不過要比上面的要求是復(fù)雜些，我這里就只講些方法，具體的應(yīng)用是千差萬別的，讓讀者自己發(fā)揮吧。 為了實現(xiàn)上述的三個需求我們設(shè)計了如下的步驟： 步驟1 ：利用INPUTBOX 函數(shù)進行人機對話 步驟2 ：利用FIND 函數(shù)進行查找 步驟3 ：利用CreateTextFile方法創(chuàng)建文本文件反饋，作為客戶的需求。 思路有了，下面我們要準(zhǔn)備我們的'積木'了，打開《VBA代碼解決方案》第一冊： 找到第40講和第7講： 打開《VBA代碼解決方案》第二冊： 找到第77講或78講 分別考出上述第40、第7、 第77講的代碼。 第40講inputbox代碼：（積木1） SubMyInputBox() Dim sInt As String Dim r As Integer r = Sheet1.Range('A65536').End(xlUp).Row sInt = InputBox('請輸入添加人員的姓名：') If Len(Trim(sInt)) > 0 Then Sheet1.Cells(r + 1, 1) = sInt Else MsgBox '您沒有輸入內(nèi)容!' End If End Sub 第7講find代碼：（積木2） SubmyFind() Dim StrFind As String Dim Rng As Range StrFind = InputBox('請輸入要查找的值:') If Trim(StrFind) <> '' Then With Sheet1.Range('A:A') Set Rng = .Find(What:=StrFind, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then Application.Goto Rng, True Else MsgBox '沒有找到該單元格!' End If End With End If End Sub 第77講CreateTextFile方法代碼：（積木3） Sub MyCreText() Dim MyFile As Object Dim myStr As String Dim j As Integer, iAs Integer Set MyFile = CreateObject('Scripting.FileSystemObject') _ .CreateTextFile(ThisWorkbook.Path & '\' & '人員表單.txt', True) For i = 1 To Range('A65536').End(xlUp).Row myStr = '' For j = 1 To Range('IV'& i).End(xlToLeft).Column myStr = myStr & Cells(i, j) & ',' Next myStr = Left(myStr, (Len(myStr) -1)) MyFile.WriteLine (myStr) Next MyFile.Close Set MyFile = Nothing End Sub 我們的積木就準(zhǔn)備好了，當(dāng)然這些積木讀者要了然于胸啊，這樣才能去快速的找到。下面我們要搭建積木了，我們注意到上述第7講FIND函數(shù)的代碼中包含了第40講的INPUTBOX的代碼，那么這就可以略去了第40講的內(nèi)容了，把積木1扔掉，用積木2和3即可，直接把積木2FIND的代碼拷貝如下，同時為了看清楚，修正一下格式： Sub myFind() Dim StrFind As String Dim Rng As Range StrFind = InputBox('請輸入要查找的值:') If Trim(StrFind) <> '' Then With Sheet1.Range('A:A') Set Rng = .Find(What:=StrFind, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then Application.Goto Rng, True '找到值后將執(zhí)行的操作 Else MsgBox '沒有找到該單元格!' End If End With End If End Sub 上述代碼中找到值后將執(zhí)行的是： Application.Goto Rng, True 操作，而我們要求執(zhí)行的是數(shù)據(jù)的導(dǎo)出操作，那么好了，就把上述Application.Goto Rng, True 操作換成代碼77講的內(nèi)容就OK了。 下面為修正后的代碼及其注釋： Public myhs As Integer '設(shè)置全局變量，用來傳遞找到了要找的人名時記錄該單元格的行數(shù) Sub myFind() Dim StrFind As String Dim Rng As Range StrFind = InputBox('請輸入要查找的人名:') '步驟1 利用INPUTBOX 函數(shù)進行人機對話 If Trim(StrFind) <> '' Then '要求用戶錄入的數(shù)據(jù)不能為空值 With Sheets('數(shù)據(jù)1').Range('A:A') '此處修正了工作表的名稱 '完全匹配查找，完成步驟2 利用FIND 函數(shù)進行查找 Set Rng = .Find(What:=StrFind, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then myhs = Rng.Row '設(shè)置傳遞函數(shù)，當(dāng)找到了要找的人名時記錄該單元格的行數(shù) MyCreText '如果找到了用戶要求的人名將進入MyCreText過程 Else MsgBox '沒有找到該人名!' End If End With End If End Sub Sub MyCreText() '如果找到了用戶要求的人名將執(zhí)行步驟3 利用CreateTextFile方法創(chuàng)建文本文件作為客戶的需求。 Dim MyFile As Object Dim myStr As String Dim j As Integer ', i As Integer I的變量去掉，用了Myhs Set MyFile = CreateObject('Scripting.FileSystemObject') _ .CreateTextFile(ThisWorkbook.Path & '\' & '人員資料.txt', True) '把要輸出的文件名稱修正為人員資料 ' For i = 1 To Range('A65536').End(xlUp).Row '此行代碼去掉，因為值是唯一的 myStr = '' For j = 1 To Range('IV' & myhs).End(xlToLeft).Column myStr = myStr & Cells(1, j) & ':' & Cells(myhs, j) & ', ' '此處修正代碼加入輸出數(shù)據(jù)的抬頭 Next myStr = Left(myStr, (Len(myStr) - 1)) MyFile.WriteLine (myStr) 'Next '此行代碼去掉，因為值是唯一的 MyFile.Close Set MyFile = Nothing MsgBox ('OK') '添加程序完成的提示 End Sub 代碼截圖： 上述的講解中你會發(fā)現(xiàn)，有了'積木'，代碼只是改了改。改動的幅度很少，這樣大量的節(jié)約了你的大量時間。 下面我們看代碼的執(zhí)行： 數(shù)據(jù)1工作表的截圖，我們要查找的是A115: 運行后提示輸入要查找的人名： 運行結(jié)束： 運行結(jié)果顯示：
再次重申一點，做程序就如同搭積木，盡可能不要去寫代碼，你把必要的積木塊拿來，組合好，你要做的只是組合、修正即可，就這么簡單。 我的《VBA代碼解決方案》中會有各式各樣的獨立的積木，給你分享，給你利用。當(dāng)然你要弄懂每講的內(nèi)容才能運用自如，才能組合、修正代碼。 |
|
|
