VBA學(xué)習(xí)心得4

干%…………¥#……&*……&*@#萬門跑路了赋咽,我最近看的課還沒看完啊真狗


V1.0 版??

Option Explicit

? ? '“Option Explicit”的作用為:聲明所有變量都需要先定義才能使用铸题,否則程序在使用了未經(jīng)定義的變量時(shí)就會(huì)報(bào)錯(cuò),

? ? '這樣,可以避免變量因名稱拼寫等錯(cuò)誤帶來的結(jié)果錯(cuò)誤礁苗,并且“Option Explicit”可以加快程序的運(yùn)行速度浦夷,它節(jié)省了在程序運(yùn)行時(shí)動(dòng)態(tài)分配變量存儲(chǔ)空間的時(shí)間

Sub 導(dǎo)入文件1_復(fù)制第一張表() '合并多工作簿中指定工作表

? ? On Error Resume Next '忽略報(bào)警錯(cuò)誤,不加此句循签,for each循環(huán),打開選擇文件時(shí)疙咸,不選文件會(huì)報(bào)錯(cuò)县匠。

? ? Dim allFile, file, arr As Variant

? ? Dim wb, twb As Workbook

? ? Dim ws, tws, tws2 As Worksheet

? ? Dim row, col, row2, col2, wb_rows, i, j As Integer

? ? Dim FirstRowNum, FirstColNum, TempRowNum, TempColNum As Integer

? ? Dim wb_name As String

? ? Dim title, titles As Range

? ? Dim a, b

? ? Dim dicTemp As Object

? ? Dim strExists As String

? ? Dim datas As Object

? ? Dim name As Range

? ? Dim xingming As Range

? ? '禁用屏幕更新和顯示警告以加快宏代碼的速度

? ? Application.ScreenUpdating = False? '

? ? Application.DisplayAlerts = False

? ? 'Workbooks("TEST.xlsx").Worksheets("Sheet1").Activate

? ? Set twb = ThisWorkbook? ? ? '設(shè)置當(dāng)前工作簿

? ? Set tws = twb.Sheets(1)? ? '設(shè)置當(dāng)前工作簿的第一張工作表

? ? Set tws2 = twb.Sheets(2)? ? '設(shè)置當(dāng)前工作簿的第二張工作表

? ? '為了便于比對,每次導(dǎo)入文件前將第二張表清空

? ? tws2.Cells.Clear? ? ? ? ? ? '將第二張工作表清空

? ? '導(dǎo)入文件

? ? allFile = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", _

? ? title:="Excel選擇", MultiSelect:=True)

? ? For Each file In allFile

? ? If file <> False Then

? ? ? ? Set wb = Workbooks.Open(file)? ? ? ? ? '循環(huán)打開選定的文件

? ? ? ? Set ws = wb.Sheets(1)? ? ? ? ? ? ? ? ? '打開選定的第一張工作表

? ? ? ? '全部復(fù)制到第二張表中

? ? ? ? col2 = tws2.UsedRange.SpecialCells(xlCellTypeLastCell).column? ? '第二張工作表中所有已使用的單元格區(qū)域列

? ? ? ? row2 = tws2.UsedRange.SpecialCells(xlCellTypeLastCell).row? ? ? ? '第二張工作表中所有已使用的單元格區(qū)域行

? ? ? ? If col2 = 1 And row2 = 1 And tws2.Cells(1, 1) = "" Then

? ? ? ? ? ? ws.UsedRange.Copy tws2.Cells(1, 1)

? ? ? ? Else

? ? ? ? ? ? ws.UsedRange.Copy tws2.Cells(row2 + 1, 1)

? ? ? ? End If

? ? ? ? '選擇性復(fù)制到第一張表

? ? ? ? col = tws.UsedRange.SpecialCells(xlCellTypeLastCell).column? ? '第一張工作表中所有已使用的單元格區(qū)域列

? ? ? ? row = tws.UsedRange.SpecialCells(xlCellTypeLastCell).row? ? ? ? '第一張工作表中所有已使用的單元格區(qū)域行

? ? ? ? 'ws.Cells.Find("姓名").Select

? ? ? ? Set name = ws.Cells.Find("姓名")? ? ? '查找姓名所在單元格

? ? ? ? 'name.Select

? ? ? ? 'MsgBox name.Address

? ? ? ? FirstRowNum = name.row? ? ? ? ? ? ? ? ? ? ? '查看姓名所在單元格在第幾行,首行

? ? ? ? FirstColNum = name.column

? ? ? ? '計(jì)算導(dǎo)入表的信息行數(shù)_TempRowNum聚唐,肯定大于1

? ? ? ? TempRowNum = Range(name, name.End(xlDown)).Rows.Count - 1

? ? ? ? TempColNum = Range(name, name.End(xlToRight)).Columns.Count

? ? ? ? '存為數(shù)組arr

? ? ? ? Set arr = Range(Cells(FirstRowNum, FirstColNum), Cells(FirstRowNum + TempRowNum, FirstColNum + TempColNum - 1))

? ? ? ? 'Rng.Parent.UsedRange? ? '選中當(dāng)前所使用的區(qū)域

? ? ? ? 'Rows(name.Row).Select? ? '選中當(dāng)前行

? ? ? ? Set titles = Intersect(arr, Rows(name.row))? ? 'intersect語句求交集丐重。

? ? ? ? 'titles.Select

? ? ? ? For Each title In titles

? ? ? ? ? ? 'a = title.row

? ? ? ? ? ? 'b = title.column

? ? ? ? ? ? If title = "姓名" Then

? ? ? ? ? ? ? ? For i = 1 To TempRowNum

? ? ? ? ? ? ? ? ? ? ws.Cells(title.row + i, title.column).Copy

? ? ? ? ? ? ? ? ? ? tws.Cells(row + i, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

? ? ? ? ? ? ? ? Next

? ? ? ? ? ? ElseIf title = "身份證" Or title = "身份證號(hào)" Or title = "身份證號(hào)碼" Then

? ? ? ? ? ? ? ? For i = 1 To TempRowNum

? ? ? ? ? ? ? ? ? ? ws.Cells(title.row + i, title.column).Copy

? ? ? ? ? ? ? ? ? ? tws.Cells(row + i, 3).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

? ? ? ? ? ? ? ? Next

? ? ? ? ? ? ElseIf title = "銀行卡" Or title = "銀行卡號(hào)" Or title = "銀行卡號(hào)碼" Or title = "賬號(hào)" Then

? ? ? ? ? ? ? ? For i = 1 To TempRowNum

? ? ? ? ? ? ? ? ? ? ws.Cells(title.row + i, title.column).Copy

? ? ? ? ? ? ? ? ? ? tws.Cells(row + i, 4).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

? ? ? ? ? ? ? ? Next

? ? ? ? ? ? ElseIf title = "開戶" Or title = "開戶行" Or title = "開戶銀行" Or title = "開戶行(需含分行及支行)" Or title = "開戶行(需含分行及支行)精確省市" Then

? ? ? ? ? ? ? ? For i = 1 To TempRowNum

? ? ? ? ? ? ? ? ? ? ws.Cells(title.row + i, title.column).Copy

? ? ? ? ? ? ? ? ? ? tws.Cells(row + i, 5).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

? ? ? ? ? ? ? ? Next

? ? ? ? ? ? ElseIf title = "應(yīng)發(fā)金額" Or title = "應(yīng)付金額(稅前金額)" Or title = "稅前" Or title = "稅前金額" Then

? ? ? ? ? ? ? ? For i = 1 To TempRowNum

? ? ? ? ? ? ? ? ? ? ws.Cells(title.row + i, title.column).Copy

? ? ? ? ? ? ? ? ? ? tws.Cells(row + i, 6).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

? ? ? ? ? ? ? ? Next

? ? ? ? ? ? ElseIf title = "個(gè)稅" Or title = "代扣金額(個(gè)稅)" Or title = "稅金" Then

? ? ? ? ? ? ? ? For i = 1 To TempRowNum

? ? ? ? ? ? ? ? ? ? ws.Cells(title.row + i, title.column).Copy

? ? ? ? ? ? ? ? ? ? tws.Cells(row + i, 7).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

? ? ? ? ? ? ? ? Next

? ? ? ? ? ? ElseIf title = "實(shí)發(fā)金額" Or title = "實(shí)發(fā)金額(實(shí)際發(fā)放金額)" Or title = "稅后" Or title = "稅后金額" Or title = "打款金額" Then

? ? ? ? ? ? ? ? For i = 1 To TempRowNum

? ? ? ? ? ? ? ? ? ? ws.Cells(title.row + i, title.column).Copy

? ? ? ? ? ? ? ? ? ? tws.Cells(row + i, 8).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

? ? ? ? ? ? ? ? Next

? ? ? ? ? ? End If

? ? ? ? Next

? ? ? ? '備注

? ? ? ? wb_name = Left(wb.name, Len(wb.name) - 5)

? ? ? ? If TempRowNum = 1 Then

? ? ? ? ? ? tws.Cells(row + 1, 9) = wb_name

? ? ? ? Else

? ? ? ? ? ? For i = row + 1 To row + TempRowNum

? ? ? ? ? ? ? ? tws.Cells(i, 9) = wb_name

? ? ? ? ? ? Next

? ? ? ? End If

? ? ? ? wb.Close

? ? End If

? ? Next

? ? '開啟屏幕刷新和顯示警告

? ? Application.ScreenUpdating = True

? ? Application.DisplayAlerts = True

End Sub

?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請聯(lián)系作者
  • 序言:七十年代末,一起剝皮案震驚了整個(gè)濱河市杆查,隨后出現(xiàn)的幾起案子扮惦,更是在濱河造成了極大的恐慌,老刑警劉巖亲桦,帶你破解...
    沈念sama閱讀 221,635評論 6 515
  • 序言:濱河連續(xù)發(fā)生了三起死亡事件崖蜜,死亡現(xiàn)場離奇詭異,居然都是意外死亡客峭,警方通過查閱死者的電腦和手機(jī)豫领,發(fā)現(xiàn)死者居然都...
    沈念sama閱讀 94,543評論 3 399
  • 文/潘曉璐 我一進(jìn)店門,熙熙樓的掌柜王于貴愁眉苦臉地迎上來舔琅,“玉大人等恐,你說我怎么就攤上這事”蛤荆” “怎么了课蔬?”我有些...
    開封第一講書人閱讀 168,083評論 0 360
  • 文/不壞的土叔 我叫張陵,是天一觀的道長郊尝。 經(jīng)常有香客問我二跋,道長,這世上最難降的妖魔是什么流昏? 我笑而不...
    開封第一講書人閱讀 59,640評論 1 296
  • 正文 為了忘掉前任扎即,我火速辦了婚禮,結(jié)果婚禮上况凉,老公的妹妹穿的比我還像新娘谚鄙。我一直安慰自己,他們只是感情好茎刚,可當(dāng)我...
    茶點(diǎn)故事閱讀 68,640評論 6 397
  • 文/花漫 我一把揭開白布襟锐。 她就那樣靜靜地躺著撤逢,像睡著了一般膛锭。 火紅的嫁衣襯著肌膚如雪。 梳的紋絲不亂的頭發(fā)上蚊荣,一...
    開封第一講書人閱讀 52,262評論 1 308
  • 那天初狰,我揣著相機(jī)與錄音,去河邊找鬼互例。 笑死奢入,一個(gè)胖子當(dāng)著我的面吹牛,可吹牛的內(nèi)容都是我干的媳叨。 我是一名探鬼主播腥光,決...
    沈念sama閱讀 40,833評論 3 421
  • 文/蒼蘭香墨 我猛地睜開眼关顷,長吁一口氣:“原來是場噩夢啊……” “哼!你這毒婦竟也來了武福?” 一聲冷哼從身側(cè)響起议双,我...
    開封第一講書人閱讀 39,736評論 0 276
  • 序言:老撾萬榮一對情侶失蹤,失蹤者是張志新(化名)和其女友劉穎捉片,沒想到半個(gè)月后平痰,有當(dāng)?shù)厝嗽跇淞掷锇l(fā)現(xiàn)了一具尸體,經(jīng)...
    沈念sama閱讀 46,280評論 1 319
  • 正文 獨(dú)居荒郊野嶺守林人離奇死亡伍纫,尸身上長有42處帶血的膿包…… 初始之章·張勛 以下內(nèi)容為張勛視角 年9月15日...
    茶點(diǎn)故事閱讀 38,369評論 3 340
  • 正文 我和宋清朗相戀三年宗雇,在試婚紗的時(shí)候發(fā)現(xiàn)自己被綠了。 大學(xué)時(shí)的朋友給我發(fā)了我未婚夫和他白月光在一起吃飯的照片莹规。...
    茶點(diǎn)故事閱讀 40,503評論 1 352
  • 序言:一個(gè)原本活蹦亂跳的男人離奇死亡赔蒲,死狀恐怖,靈堂內(nèi)的尸體忽然破棺而出良漱,到底是詐尸還是另有隱情嘹履,我是刑警寧澤,帶...
    沈念sama閱讀 36,185評論 5 350
  • 正文 年R本政府宣布债热,位于F島的核電站砾嫉,受9級(jí)特大地震影響,放射性物質(zhì)發(fā)生泄漏窒篱。R本人自食惡果不足惜焕刮,卻給世界環(huán)境...
    茶點(diǎn)故事閱讀 41,870評論 3 333
  • 文/蒙蒙 一、第九天 我趴在偏房一處隱蔽的房頂上張望墙杯。 院中可真熱鬧配并,春花似錦、人聲如沸高镐。這莊子的主人今日做“春日...
    開封第一講書人閱讀 32,340評論 0 24
  • 文/蒼蘭香墨 我抬頭看了看天上的太陽嫉髓。三九已至观腊,卻和暖如春,著一層夾襖步出監(jiān)牢的瞬間算行,已是汗流浹背梧油。 一陣腳步聲響...
    開封第一講書人閱讀 33,460評論 1 272
  • 我被黑心中介騙來泰國打工, 沒想到剛下飛機(jī)就差點(diǎn)兒被人妖公主榨干…… 1. 我叫王不留州邢,地道東北人儡陨。 一個(gè)月前我還...
    沈念sama閱讀 48,909評論 3 376
  • 正文 我出身青樓,卻偏偏與公主長得像,于是被迫代替她去往敵國和親骗村。 傳聞我的和親對象是個(gè)殘疾皇子嫌褪,可洞房花燭夜當(dāng)晚...
    茶點(diǎn)故事閱讀 45,512評論 2 359

推薦閱讀更多精彩內(nèi)容