2020

September


#xls转换为xlsx格式
import win32com.client as win32
fname = "C:\\Users\\Administrator\\Desktop\\测试\\医疗.xls"
excel = win32.gencache.EnsureDispatch('Excel.Application')
wb = excel.Workbooks.Open(fname)
wb.SaveAs(fname+"x", FileFormat = 51)    #FileFormat = 51 is for .xlsx extension
wb.Close()                               #FileFormat = 56 is for .xls extension
excel.Application.Quit()
#引用EXCEL函数
from openpyxl import load_workbook 

workbook = load_workbook("C:\\Users\\Administrator\\Desktop\\测试\\医疗.xlsx")
sheet = workbook["Sheet1"]
sheet["G1"] = "补缴" #查找后补充至该字段
for i in range(2,sheet.max_row+1): 
    # sheet[f"G{i}"] = f'=VLOOKUP(A{i},$K$1:$L$5,2,0)'
    sheet[f"G{i}"] = f'=SUMIFS(L:L,K:K,A{i})'
workbook.save(filename = "C:\\Users\\Administrator\\Desktop\\测试\\医疗VLOOKUP.xlsx")
print("取数完成")

September 20 , 2020 阅读全文

June

    陌上雨，花露浓。

    经雨长篱短寒松。

    枝头月，岭边风。

    倚风疏叶矮梧桐。

    人间虚胜景。

    何处觅春踪？

    绿杨村巷外，茅舍小园中。

    桃红十万丛，李红十万丛！

    June 27 , 2020 樵林后子  阅读全文

    Sub Collectwk()

    'ExcelHome VBA编程学习与实践

    Dim Trow&, k&, arr, brr, i&, j&, book&, a&

    Dim p$, f$, Rng As Range

    With Application.FileDialog(msoFileDialogFolderPicker)

    '取得用户选择的文件夹路径

        .AllowMultiSelect = False

        If .Show Then p = .SelectedItems(1) Else Exit Sub

    End With

    If Right(p, 1) <> "\" Then p = p & "\"

    '

    Trow = Val(InputBox("请输入标题的行数", "提醒"))

    If Trow < 0 Then MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub

    Application.ScreenUpdating = False '关闭屏幕更新

    Cells.ClearContents '清空当前表数据

    Cells.NumberFormat = "@" '设置单元格格式为文本

    ReDim brr(1 To 200000, 1 To 1)

    '定义装汇总结果的数组brr，最大行数为20万行

    f = Dir(p & "*.xls*")

    '开始遍历指定文件夹路径下的每个工作簿

    Do While f <> ""

        If f <> ThisWorkbook.Name Then '避免同名文件重复打开出错

            With GetObject(p & f)

            '以\'只读\'形式读取文件时，使用getobject方法会比workbooks.open稍快

                Set Rng = .Sheets(1).UsedRange

                If IsEmpty(Rng) = False Then '如果工作表非空

                    book = book + 1 '标记一下是否首个Sheet,如果首个sheet，BOOK=1

                    a = IIf(book = 1, 1, Trow + 1) '遍历读取arr数组时是否扣掉标题行

                    arr = Rng.Value '数据区域读入数组arr

                    If UBound(arr, 2) > UBound(brr, 2) Then

                    '动态调整结果数组brr的最大列数，避免明细表列数不一的情况。

                        ReDim Preserve brr(1 To 200000, 1 To UBound(arr, 2))

                    End If

                    For i = a To UBound(arr) '遍历行

                        k = k + 1 '累加记录条数

                        For j = 1 To UBound(brr, 2) '遍历列

                            brr(k, j) = arr(i, j)

                        Next

                    Next

                End If

                .Close False '关闭工作簿，不保存。

            End With

        End If

        f = Dir '下一个工作簿

    Loop

    If k > 0 Then

        [a1].Resize(k, UBound(brr, 2)) = brr

        MsgBox "汇总完成。"

    End If

    Application.ScreenUpdating = True '恢复屏幕更新

End Sub

    源文件

    June 2 , 2020 阅读全文

May

    设置Outlook收件箱（Inbox）下建立子文件夹attachment；

    计算机磁盘选定路径建立目标文件夹attachment download；

    输入代码块中的代码（文件夹名和路径名）

    Sub Savetheattachment()
         Dim olApp As New Outlook.Application
         Dim nmsName As Outlook.NameSpace
         Dim vItem As Object
         Set nmsName = olApp.GetNamespace("MAPI")
         Set myfolder = nmsName.GetDefaultFolder(olFolderInbox)
         Set fldFolder = myfolder.Folders("attachment")
         For Each vItem In fldFolder.Items
             For Each att In vItem.Attachments
                 att.SaveAsFile "D:\attachment download\" & att.FileName
             Next
         Next
            Set fldFolder = Nothing
            Set nmsName = Nothing
End Sub

    May 31 , 2020 阅读全文

April

March