花了好幾天時間想思路,找Excel函數(shù)公式和vba代碼,不停地推翻思路重新來。最后終于做好了,雖然手動輸入可能也得花這幾天時間,但做完之后成就感爆棚啊!
大致內(nèi)容是有500+單獨的excel樣式的加盟合同臺賬,我要提取其中200+加盟商六個費用的的對應值。
1.我把標有無合同字樣和多余的excel表格刪除,剩下400+excel。
2.用vba把它們匯總成一個excel的多個sheet,把這些sheet的名稱做成目錄,摘取目錄中的ID信息。
打開excel表,ALT+F11-->打開VBA編輯器-->插入-->模塊
vba代碼如下:
Sub MergeWorkbooks()
? ? Dim FileSet
? ? Dim i As Integer?
? ? On Error GoTo 0
? ? Application.ScreenUpdating = False
? ? FileSet = Application.GetOpenFilename(FileFilter:="Excel 2016(*.xls),*.xls,Excel 2016(*.xlsx),*.xlsx", _
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? MultiSelect:=True, Title:="選擇要合并的文件")
? ? If TypeName(FileSet) = "Boolean" Then
? ? ? ? GoTo ExitSub
? ? End If
? For Each Filename In FileSet
? ? ? ? Workbooks.Open Filename
? ? ? ? Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
? ? Next
ExitSub:
? ? Application.ScreenUpdating = True
End Sub
3.再用vba把這些sheet的內(nèi)容匯總到一個表里。對關鍵字做篩選,摘取自己要的關鍵信息,與目錄的ID信息匯總。
Function LastRow(sh As Worksheet)
? ? On Error Resume Next
? ? LastRow = sh.Cells.Find(what:="*", _
? ? ? ? ? ? ? ? ? ? ? ? ? ? After:=sh.Range("A1"), _
? ? ? ? ? ? ? ? ? ? ? ? ? ? Lookat:=xlPart, _
? ? ? ? ? ? ? ? ? ? ? ? ? ? LookIn:=xlFormulas, _
? ? ? ? ? ? ? ? ? ? ? ? ? ? SearchOrder:=xlByRows, _
? ? ? ? ? ? ? ? ? ? ? ? ? ? SearchDirection:=xlPrevious, _
? ? ? ? ? ? ? ? ? ? ? ? ? ? MatchCase:=False).Row
? ? On Error GoTo 0
End Function
Sub MergeSheets()
? ? Dim sh As Worksheet
? ? Dim DestSh As Worksheet
? ? Dim Last As Long
? ? Dim shLast As Long
? ? Dim CopyRng As Range
? ? Dim StartRow As Long
? ? Application.ScreenUpdating = False
? ? Application.EnableEvents = False
? ? '新建一個“匯總”工作表
? ? Application.DisplayAlerts = False
? ? On Error Resume Next
? ? ActiveWorkbook.Worksheets("匯總").Delete
? ? On Error GoTo 0
? ? Application.DisplayAlerts = True
? ? Set DestSh = ActiveWorkbook.Worksheets.Add
? ? DestSh.Name = "匯總"
? ? '開始復制的行號,忽略表頭,無表頭請設置成1
? ? StartRow = 2
? ? For Each sh In ActiveWorkbook.Worksheets
? ? ? ? If sh.Name <> DestSh.Name Then
? ? ? ? ? ? Last = LastRow(DestSh)
? ? ? ? ? ? shLast = LastRow(sh)
? ? ? ? ? ? If shLast > 0 And shLast >= StartRow Then
? ? ? ? ? ? ? ? Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
? ? ? ? ? ? ? ? If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
? ? ? ? ? ? ? ? ? ? MsgBox "內(nèi)容太多放不下啦!"
? ? ? ? ? ? ? ? ? ? GoTo ExitSub
? ? ? ? ? ? ? ? End If
? ? ? ? ? ? ? ? CopyRng.Copy
? ? ? ? ? ? ? ? With DestSh.Cells(Last + 1, "A")
? ? ? ? ? ? ? ? ? ? .PasteSpecial xlPasteValues
? ? ? ? ? ? ? ? ? ? .PasteSpecial xlPasteFormats
? ? ? ? ? ? ? ? ? ? Application.CutCopyMode = False
? ? ? ? ? ? ? ? End With
? ? ? ? ? ? End If
? ? ? ? End If
? ? Next
ExitSub:
? ? Application.GoTo DestSh.Cells(1)
? ? DestSh.Columns.AutoFit
? ? Application.ScreenUpdating = True
? ? Application.EnableEvents = True
End Sub
4.最后做個vlookup函數(shù),對標200+ID信息。
說起來很容易,但碰到過很多麻煩。
1.500+excel表格數(shù)據(jù)量太大,用vba還是會出現(xiàn)錯誤的地方,還好只是sheet標題改了,還會有多余重復名稱的sheet,只能手動改了。
2.因為是不同的人做的表格,有的表格格式不規(guī)范,導致后來篩選的數(shù)據(jù)與目錄ID對不上,只能手動找了。也是心累,還好不多。。。
3.最大的難點是每張sheet的內(nèi)容沒有ID信息,我最開始想過要不要在每張sheet上加上ID內(nèi)容,但是一直沒找到好方法,只得作罷,ID信息只有sheet標題上有。所以只有保證匯總sheet的順序與目錄ID的順序一致就行。所以每張單獨sheet的格式必須規(guī)范了,也就是提醒我們說,平時的基礎工作不要偷懶啊啊啊啊啊!
PS:VBA代碼一點也看不懂,全是網(wǎng)上復制粘貼的,在此附上鏈接
https://blog.csdn.net/nsj820/article/details/6327216
重要的是邏輯,代碼函數(shù)也要慢慢學!