后台打开工作簿读取内容源码: Sub subOpenWorkbook() Dim datebase As String datebase = "... ....xlsx" Application.ScreenUpdating = False '关闭屏幕 Workbooks.Open datebase, ReadOnly:=True '只读方式打开工作簿 Dim oWB As Workbook Set oWB = ActiveWorkbook ThisWorkbook.Activate
动态数组使用: https://zhidao.baidu.com/question/1432222709706721499.html 使用Redim动态数组即可. 1 2 3 4 5 6 7 8 Sub test1() Dim a() As Integer, iRow As Long, i As Integer iRow = Cells(Rows.Count, 1).End(xlUp).Row ReDim a(iRow - 1) For i = 1 To UBou
我们项目管理有两个工作薄,一个里面有多个表,每天建一个,记录当天项目,另一个工作薄,有多个表,其中一个是所有项目汇总. 以前都是第一个工作薄一个表做完,再复制粘贴到第二个工作薄的汇总表中. 写了个VBA宏完成这个工作. Sub CopyToOtherBook() ' ' copyToOtheBook Macro ' 宏由 cuianzhu 录制,时间: 2013-6-18 ' ' Dim fname As String Dim maxLine As Integer Dim maxLineS As
sub 汇总多个工作簿() Application.ScreenUpdating = False Dim wb As Workbook, f As String, l As String, n As String, m As String, j As Integer f = ThisWorkbook.Path & "\" l = f & "*.xls" m = Dir(l) Do While m <> "" If m
打开关闭工作簿等 1 Sub 打开工作簿() 2 Dim sFilePath As String 3 sFilePath = "D:\A.xls" 4 Dim oWB As Workbook 5 Set oWB = Excel.Workbooks.Open(sFilePath, ReadOnly:=False, writerespassword:="123") 6 delay (5) 7 If Not oWB.ReadOnly Then 8 9 oWB.Close
Sub clData() Dim ComputerCount As Object tms = Timer p = ThisWorkbook.Path & "\" f = Dir(p & "*.xls") Application.ScreenUpdating = False tms = Timer On Error Resume Next Set Rng = ThisWorkbook.Sheets("sheet1") Rng.Ran
Private Sub getValue_Click() Dim MyWorkbook As Workbook Set MyWorkbook = Application.Workbooks.Open("C:\Users\jiangwenwen\Desktop\VBAテスト\テスト2.xlsx") ThisWorkbook.Sheets("Sheet1").Range("A1").value = MyWorkbook.Sheets("Sh
