| 共 37 篇文章 |
|
37，多文件夹多工作簿多工作表汇总(searfile)Dim Arr, myPath$, myName$, wb As Workbook, sh As Worksheet.For i = 1 To UBound(Brr, 2)nm = aa(UBound(aa) - 1)SheetsInNewWorkbook = UBound(aa) + 1.For j = 0 To UBound(aa)Arr = sh.Resize(UBound(Arr), UBound(Arr, 2)) = Arr.Dim Arr, myPath$, myName$, d, k, t.Dim wb As Workbook, nm... 阅263 转9 评0 公众公开 17-04-05 22:05 |
36，多工作簿搜索公式并复制工作簿。Dim FilePath As String,FileName As String.Dim SavePath As String,Folder As Object, ar.If Folder Is Nothing Then Exit Sub.FilePath = Folder.items.SavePath = Folder.items.FileName = Dir(FilePath& "*.xls*")Name Then ''判断是不是本工作簿。Open(FilePath &FileN... 阅55 转4 评0 公众公开 17-04-05 22:05 |
35，多工作簿多工作表汇总(searfile)Dim fp As String, Arr1, i&, j&, r1, col%.Call searfile(fp, ".xls")Arr1 = .Cells(3, col) = Left(Brr(2, i), Len(Brr(2, i)) - 4)Sub searfile(fp AsString, fkey As String)Dim Arr1() As String, i1 As Integer, i2 As Integer, fm.If Right(fp, 1) <>"\" Then fp ... 阅155 转8 评0 公众公开 17-04-05 22:05 |
Dim Arr1, myPath$,myName$, shnm, nm.If Arr1(i, 3) = "?"Or Arr1(i, 6) = "?"Or Arr1(i, 9) ="?" Then.If d.exists(Arr(j, 1)) Then.If Arr1(n, 3) = "?"Then Arr1(n, 3) = Arr(j, 3)If Arr1(n, 6) = "?"Then Arr1(n, 6) = Arr(j, 4)If Arr1(n, 9) = "?"Then Arr1(n, 9) = Arr(... 阅349 转7 评0 公众公开 17-04-05 22:04 |
33，多工作表汇总，先赋值给数组。Dim Arr, i&, Sht AsWorksheet, mm&, Brr.Name, "工资") And Sht.Name <>Sheet5.Name Then.Arr = Sht.[a1].For i = 3 To UBound(Arr)d(Arr(i, 1)) = d(Arr(i, 1)) &i &","ReDim Brr(1 To d.For j = 0 To UBound(aa)Brr(i + 1, y - 1) = Brr(i + 1, y - 1) + Arr(aa... 阅132 转6 评0 公众公开 17-04-05 22:04 |
32，多工作簿汇总，先赋值给数组。Dim myPath$, myName$, dAs Object, Arr, Brr(1 To 60000, 1 To 22), i&, j&, m&, s$Arr = .For i = 2 To UBound(Arr)s = Arr(i, 1) &"," &Arr(i, 6) &"," &Arr(i, 10) &"," &Arr(i, 12)d(s) = Arr(i, 14)For j = 1 To UBound(Arr, 2)Brr(... 阅133 转6 评0 公众公开 17-04-05 22:04 |
31，多工作簿汇总(vbDirectory)Dim myPath$, subPath$,shcount&, wb As Object.Dim subPaths() As Byte,br()subPath = Dir(myPath,vbDirectory)If subPath <>"."And subPath <>".."Then.subPaths(k) = Val(Replace(subPath, "月份", ""))For j = i + 1 To UBound(subPaths)If subPath... 阅327 转8 评0 公众公开 17-04-05 22:04 |
Dim myPath$, myName$,Arr1.Dim myPath$, myName$,Arr1, nm, col, aa, x$x = Arr1(j, aa(0)) &"," &Arr1(j, aa(1))Dim Arr, myPath$,myName$, Arr1, Myr&Resize(UBound(Arr1) - 1, UBound(Arr1,2))Resize(UBound(Arr), UBound(Arr, 2)) = Arr.Dim Arr, myPath$,myName$, wb As Workbook, sh As Worksheet.Resize(UBound(... 阅772 转16 评0 公众公开 17-04-05 22:03 |
29，2007版FSO方法多工作簿汇总。Dim Fso As Object, Fld,Fl, nm, col%, Arr, Myc%, r1, Myr&, i&, j&, y&Arr = GetObject(Fl.If Not IsArray(Arr) Then GoTo 100.Cells(1, Myc) = Arr(1, j)Cells(2, Myc) = "销售数量"Row, Myc) = Arr(y, j)Cells(Myr, 1) = Cells(Myr - 1, 1) + 1.Cells(Myr, 2) = Arr(y, 2)Cells(... 阅57 转4 评0 公众公开 17-04-05 22:03 |
28，2007版FSO方法搜索文件夹文件。Dim Fso, Folder,myPath$, hz$, sh As Worksheet.Dim i&, nm1$, Files,File, r%, c%.Set Fso =CreateObject("Scripting.FileSystemObject")Set Files = myfol.If Files.For Each File In Files.If InStr(File, hz) Then.nm1 = Mid(File, InStrRev(File, "\") + 1)Set Folder =Fso.ge... 阅114 转4 评0 公众公开 17-04-05 22:03 |
