|
本帖最后由 萧瑟处 于 2022-8-23 15:52 编辑
Sub 社保汇总()
Dim filter As String, k As String
Dim filetoopen, arr, brr
Dim i As Integer
Dim wk As Workbook
Dim maxrow As Long
Dim rng As Range
Dim sht As Worksheet
Application.DisplayAlerts = False
filter = "all files(*.*),*.*,word documents(*.do*),*.do*,text files(*.txt),*.txt,excel files(*.xl*),*.xl*"
filetoopen = Application.GetOpenFilename(filter, 4, "请选择文件", , True)
Set sht = ActiveSheet
sht.Cells.Clear '删除旧数据
sht.Columns(3).NumberFormatLocal = "@"
If IsArray(filetoopen) = False Then
MsgBox "你没有选择文件"
Else
For i = 1 To UBound(filetoopen)
Set wk = Workbooks.Open(filetoopen(i))
Sheet1.Select
maxrow = Sheet1.Range("E65536").End(xlUp).Row
arr = Sheet1.Range("b2:R" & maxrow)
brr = Sheet1.Range("a1:R1")
wk.Close False
sht.Range("b" & sht.Range("b65536").End(xlUp).Row + 1).Resize(UBound(arr), UBound(arr, 2)) = arr
sht.Range("a1:R1") = brr
Next i
End If
For i = 2 To sht.Range("B65536").End(xlUp).Row
sht.Cells(i, 1) = i - 1
Next
k = Range("k2") & "医疗汇总"
sht.Name = k
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & k
End Sub
|
|