VBA-Track

一、简单的Excel文件打开复制

GetObject&Workbooks.open 
1） 通过getobject打开的Excel文件只要被修改（写）并保存后，
就只能在VBE中看到，但用户界面却看不到。就算你重启Excel，
再去手动打开此文件，也是什么都看不到。不保存就没有这个问题！如果要解决这个问题，
必须在wb.close 1前加一句Application.Windows(wb.name).Visible = True。Open语句就完全没有这个问题。

2） 通过getobject打开有打开密码的工作簿时，
要使用Sendkeys并且要DoEvents，在同时有其他类似密码输入的登录窗体时，
处理起来也是比较麻烦的。而且在有循环使用getobject的场合，
多次重复使用DoEvents也许会出现意想不到的问题。而Open语句就非常稳定。

3） 一般情况下，getobject给人的感觉是隐藏打开工作簿的。
但经过我的实际测试，发现如果打开的文件放在公共盘上，
由于网速的限制等原因导致打开工作簿的速度很慢时，也还是能看到这个文件的内容。

Application.ScreenUpdating = False    实时刷新的开关

Application.DisplayAlerts = False　　　警告提示的开关

　m = ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp).Row + 1
　i = .Range("A65536").End(xlUp).Row

Sub test()
  Dim r%, i%
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim mypath$, myname$
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  mypath = ThisWorkbook.Path & "\"
  myname = Dir(mypath & "*.csv")
  With Worksheets(1)
    .UsedRange.Offset(3, 0).Clear
  End With
  m = 3
  Do While myname <> ""
    If myname <> ThisWorkbook.Name Then
      Set wb = GetObject(mypath & myname)
      With wb
        With .Worksheets(1)
　　　　　　
          m = m + 1
          .Range("A2:BP2").Copy
　　　　　　ThisWorkbook.Worksheets(1).Cells(m, 2).PasteSpecial Paste:=xlPasteValues
          ThisWorkbook.Worksheets(1).Cells(m, 1) = Mid(myname, 1, 2)
        End With
        .Close False
      End With
    End If
    
    myname = Dir
  Loop
End Sub

二、获取某文件夹下所有文件和子文件目录的文件

f = Dir(file(i), vbDirectory)

执行f = Dir(ThisWorkbook.Path, vbDirectory)后返回的是当前工作簿路径下的文件夹名称
Dir[(pathname[, attributes])]
pathname 可选参数。用来指定文件名的字符串表达式，可能包含目录或文件夹、以及驱动器。
如果没有找到 pathname，则会返回零长度字符串 ("")。
attributes 可选参数。常数或数值表达式，其【总和】用来指定文件属性。
如果省略，则会返回匹配 pathname 但不包含属性的文件。  
attributes 参数的设置可为：
常数 值 描述
vbNormal 0 (缺省) 指定没有属性的文件。
vbReadOnly 1 指定无属性的只读文件
vbHidden 2 指定无属性的隐藏文件
VbSystem 4 指定无属性的系统文件 在Macintosh中不可用。
vbVolume 8 指定卷标文件；如果指定了其它属性，则忽略vbVolume 在Macintosh中不可用。
vbDirectory 16 指定无属性文件及其路径和文件夹。
vbAlias 64 指定的文件名是别名，只在Macintosh上可用。

Sub getAllFile()

On Error Resume Next
Dim f As String
Dim file() As String
Dim wb As Workbook
Dim ws As Worksheet
Dim mypath$, myname$
Dim i, k, x, n

i = 1
k = 1

Arr = Array("*SingleLineHXT_Green_left_SingleLineHXT_1#.csv", "*SingleLineHXT_Green_left_BaseA_1#.csv", 

"*SingleLineHXT_White_left_SingleLineHXT_1#.csv", "*SingleLineHXT_White_left_BaseA_1#.csv", "*SingleLineHXT_Green_right_SingleLineHXT_1#.csv", 

"*SingleLineHXT_Green_right_BaseB_1#.csv", "*SingleLineHXT_White_right_SingleLineHXT_1#.csv", "*SingleLineHXT_White_right_BaseB_1#.csv")

ReDim file(1 To i)
'file(1) = sFolderPath & "\"
file(1) = ThisWorkbook.Path & "\"

'-- 获得所有子目录
Do Until i > k
    f = Dir(file(i), vbDirectory)
        Do Until f = ""
            If InStr(f, ".") = 0 Then
                k = k + 1
                ReDim Preserve file(1 To k)
                'file(k) = file(i) & f & "\"
                file(k) = f
            End If
            f = Dir
        Loop
    i = i + 1
Loop

'-- 获得所有子目录下的所有文件
For i = 2 To k
    Worksheets.Add 'before:=Worksheets("数据分析")
    ActiveSheet.Name = file(i)
    j = 5
    x = 4
      For n = 0 To 7
        myname = Dir(ThisWorkbook.Path & "\" & file(i) & "\" & Arr(n))

        Set wb = GetObject(ThisWorkbook.Path & "\" & file(i) & "\" & myname)
         With wb
             With .Worksheets(1)
            .Range("A1:H13").Copy ThisWorkbook.Worksheets(file(i)).Cells(j, 2)
            ThisWorkbook.Worksheets(file(i)).Cells(x, 1) = Mid(myname, 1, 100)
            
            ThisWorkbook.Worksheets("数据分析").Range("J4:Q115").Copy ThisWorkbook.Worksheets(file(i)).Range("J4")
            
            j = j + 14
            x = x + 14
            End With
        End With
     Next

Next
    
End Sub

Do Until i > k
    f = Dir(file(i), vbDirectory)
        Do Until f = ""
            If InStr(f, ".") = 0 Then
                k = k + 1
                ReDim Preserve file(1 To k)
                file(k) = file(i) & f & "\"
            End If
            f = Dir
        Loop
    i = i + 1
Loop

For i = 1 To k
    f = Dir(file(i) & "*.*")    
    Do Until f = ""
       'Range("a" & x) = f
       Range("a" & x).Hyperlinks.Add Anchor:=Range("a" & x), Address:=file(i) & f, TextToDisplay:=f
        x = x + 1
        f = Dir
    Loop
Next

三、Excel的工作表读取

For Each 循环用于执行语句或一组为数组或集合的每个元素。

循环类似于For循环; 然而，该循环被执行用于在阵列或组的每个元素。

因此，步进计数器将不会在这种类型的环的存在，它主要用于数组或用在文件系统对象的上下文，以递归方式运行。

For Each 变量 in 数组/单元格/sheet表

Do While FileName <> ""
    If FileName <> ff Then

       'Workbooks.Open (Path & FileName)
       'Set wb = GetObject(Path & FileName)
        Set wb = Workbooks.Open(Path & FileName)
        For Each ws In Worksheets
            If i < 5 Then
                
            Else
                i = 0
                j = 5
                n = n + 1
            End If
            If ws.Name <> "数据" Then
                ws.Range("L4:Q16").Copy
                ThisWorkbook.Worksheets(n).Cells(j, 2).PasteSpecial Paste:=xlPasteValues
                ThisWorkbook.Worksheets(n).Cells(j - 1, 1) = ws.Name
                j = j + 16
                i = i + 1
            
            End If
         Next
         wb.Close False
    End If
        
   FileName = Dir
   
Loop

Sub R()
    Dim cell As Range, i As Integer　　　　　　'声明变量
    For Each cell In Range("B1:H13")
        cell.Value = "R" & cell.Row & "C" & cell.Column
    Next
End Sub

四、排序

Excel VBA解读（54）：排序——Sort方法

    With ActiveSheet.Sort
        With .SortFields
            .Clear
            .Add Key:=Range("B2"), Order:=xlAscending
        End With
        .Header = xlGuess
        .MatchCase = False
        .SortMethod = xlPinYin
        .Orientation = xlSortColumns
        .SetRange Rng:=Range("A1:M257")
        .Apply
    End With

五、新建多个sheets

https://blog.csdn.net/znyang/article/details/14120817

    Dim wb As Workbook
    Set wb = Workbooks.Add
    With wb.Worksheets
        .Add After:=wb.Worksheets(.Count), Count:=5 - .Count
    End With

posted @ 2020-11-27 16:14 sMei 阅读(204) 评论(0) 收藏举报

刷新页面返回顶部

sMei

随波逐流的人生让人无趣。

VBA-Track

Excel VBA解读（54）：排序——Sort方法

公告