干%…………¥#……&*……&*@#萬門跑路了赋咽,我最近看的課還沒看完啊真狗
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