吕雄

2020

September

python实现sumifs函数功能

import pandas as pd
#医疗生育表
dfyl=pd.read_excel('C:\\Users\\Administrator\\Desktop\\测试\\医疗.xls',encoding='utf-8')
print(dfyl.head())


# 汇总表
dfhz=pd.read_excel('C:\\Users\\Administrator\\Desktop\\测试\\汇总表.xlsx',encoding='utf-8')
print(dfhz["姓名"][1])
counts=dfhz['姓名'].count()-1
for i in range(0,counts): 
      dfhz["医疗单位补缴"][i] = dfyl[(dfyl.姓名 == dfhz["姓名"][i]) & (dfyl.做账期号 == dfhz["期间"][i])].医疗单位补缴.sum()
      dfhz["医疗单位"][i] = dfyl[(dfyl.姓名 == dfhz["姓名"][i]) & (dfyl.做账期号 == dfhz["期间"][i])].医疗单位.sum()
      
print(dfhz.head())
dfhz.to_excel('C:\\Users\\Administrator\\Desktop\\测试\\汇总表.xlsx', sheet_name='汇总表',index=False)

September 20 , 2020 阅读全文

Python内引用excel函数


#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

VBA跨excel工作簿提取首个工作表数据

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

VBA设置OUTLOOK批量提取多个邮件下的附件

设置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

VBA设置excel单元格下拉菜单多选

Private Sub Worksheet_Change(ByVal Target As Range)
' Developed by Contextures Inc.
' www.contextures.com
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler

If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column = 2 And Target.Row = 10 Then '此处选定第2列第10行(B10)的单元格为需要设置下拉多选的单元格
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
        If InStr(1, oldVal, newVal) <> 0 Then  '重复选择视同删除
          If InStr(1, oldVal, newVal) + Len(newVal) - 1 = Len(oldVal) Then '最后一个选项重复
            Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
          Else
            Target.Value = Replace(oldVal, newVal & ",", "") '不是最后一个选项重复的时候处理逗号
          End If
        Else '不是重复选项就视同增加选项
        Target.Value = oldVal & "," & newVal
'      NOTE: you can use a line break,
'      instead of a comma
'      Target.Value = oldVal _
'        & Chr(10) & newVal
        End If
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

March 23 , 2020 阅读全文