常用EXCEL宏FUNCTION 2020.11.20「建议收藏」

Function walkthrough(path)
' 遍历文件（文件夹路径）
   Dim xls
   xls = Dir(path & "\*.xls")
'指定要遍历excel文件的路径及文件类型
   Do While xls <> ""
      
      Call **copythefile(xls)**    ' 要执行的程序
    
      xls = Dir '下一个excel文件
   Loop
   Set xls = Nothing '释放变量内存
End Function

Function copythefile(filename)
' 复制文件
    Dim book As Workbook
    Dim sheet As Worksheet
    Dim rc As Integer
    Dim abc As Integer
      
    Set book = Workbooks.Open(filename)
    Set sheet = book.Sheets(1) '使用第一个sheet
    rc = sheet.Range("A65536").End(xlUp).Row
    abc = ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Row
    
        sheet.Rows(2 & ":" & rc).Copy 
        `从第二行开始到最下面一行复制
        ThisWorkbook.Sheets(1).Range("A" & abc + 1)
         '复制到A列最下面的行
         book.Close
         
End Function

Function selectthefolder() As String
' 窗口选择文件夹

    With Application.FileDialog(msoFileDialogFolderPicker)
        ' 窗口选择文件
        
        .Title = "请选择不顺眼的文件"
        '窗口的名称

        .InitialFileName = "C:\Documents and Settings\Administrator\桌面\"
        '窗口的默认文件地址

        If .Show = -1 Then
        'FileDialog 对象的 Show 方法显示对话框，并且返回 -1（如果按 OK）和 0（如果按 Cancel）
        '按ok执行下方，按cancel退出宏

            selectthefolder = .SelectedItems(1)
            ' 1 表示只选择一个文件

            Else: Exit Function
        End If
    End With
End Function

Function fill_cells()
    取消合并单元格并填充

    Dim rng As Range, val, cell As String
    For Each rng In ActiveSheet.UsedRange
     If rng.MergeCells Then
       cell = rng.MergeArea.Address
     val = rng.Value
     rng.UnMerge
     Range(cell).Value = val
 End If
 Next

End Function

Sub main()

fill_cells

End Sub

today_date = VBA.Date
' 获取日期数据创建日期数据
month_date = VBA.Month(today_date)
day_date = VBA.Day(today_date)
year_date = VBA.Year(today_date)

Dim a As Date
Dim b As Date

a = today_date
MsgBox (a)
MsgBox (day_date)
MsgBox (month_date)
MsgBox (year_date)

b = Str(year_date) + "-" + Str(month_date) + "-1"

MsgBox (b)