07 2017 档案
摘要：Public Sub Recent100() Dim WebText As String Dim Reg As Object, Mh As Object, OneMh As Object Dim i As Long, j As Long, Nums As String Set Reg = CreateObject("Vbscript.Regexp") ...
阅读全文
摘要：Public Sub SSCLastTwoDays() Dim strText As String Dim Reg As Object, Mh As Object, OneMh As Object Dim i As Long Set Reg = CreateObject("Vbscript.Regexp") With Reg .Mult...
阅读全文
摘要：Public Sub SSC_TODAY() Dim strText As String Dim Reg As Object, Mh As Object, OneMh As Object Dim i As Long With CreateObject("MSXML2.XMLHTTP") .Open "GET", "http://cp.360.c...
阅读全文
摘要：Sub MatchData() Dim i As Long, EndRow As Long, Key As String Dim Rng As Range Dim Dic As Object Set Dic = CreateObject("Scripting.Dictionary") '获取数据来源 With Sheets("数据来源") ...
阅读全文
摘要：Sub 导出() Dim Sht As Worksheet, ShtName As String Dim NextRow As Long, NextRow2 As Long Dim iRow As Long, Index As Long Dim mySum As Double iRow = 2 Sheets("地块表").Activat...
阅读全文
摘要：Sub CountingDown() Dim Dic As Object '用于分类统计 Dim i As Long Dim CountDown As Long '每页最多几条信息 Dim x As Long, y As Long Dim Page As Long '页数 Dim Index As Long '每页的序号 ...
阅读全文
摘要：Sub CreateTables() Dim Wb As Workbook Dim OpenWb As Workbook Dim Sht As Worksheet Dim Rng As Range Dim Arr As Variant Dim i As Long Const HEAD_ROW As Long = 2 Dim EndR...
阅读全文
摘要：Public Sub RegExtractData() Dim StartTime, UsedTime StartTime = VBA.Timer Dim FilePath$ Dim FileName$ Dim doc As Document Dim Arr() As String Dim ExamNo As String Dim...
阅读全文
摘要：Sub AbsorbThisProcedure() If Application.VBE.MainWindow.Visible = False Then MsgBox "请先激活VBE编辑窗口再执行!" Exit Sub End If On Error Resume Next Set VbCodePane = Applicati...
阅读全文
摘要：Public Sub SmartIndenterProcedure() Dim OneComp As VBComponent Dim StartLine As Long, EndLine As Long Dim LineIndex As Long, LineNo As Long, LineCount Dim StartCol As Long, EndCol As ...
阅读全文
摘要：Sub CreateSaleList() AppSettings On Error GoTo ErrHandler Dim StartTime As Variant '开始时间 Dim UsedTime As Variant '使用时间 StartTime = VBA.Timer '记录开始时间 Dim Wb As Work...
阅读全文
摘要：Public Sub SameFolderGather() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.StatusBar = ">>>>>程序正在转化，请...
阅读全文
摘要：Public Sub GatherDataPicker() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.StatusBar = ">>>>>>>>程序正在运...
阅读全文
摘要：Public Sub CustomSubTotal() AppSettings On Error GoTo ErrHandler Dim StartTime, UsedTime As Variant StartTime = VBA.Timer 'Input code here Dim i As Long, j As Long, k Dim...
阅读全文
摘要：Sub 筛选OutLook主题并转发() On Error Resume Next Dim OutApp As Application Set OutApp = Application Dim OutMail As MailItem Dim OneAccount As Account Dim UsingAccount As Account ...
阅读全文
摘要：Public Sub StartRecursionFolder() Dim Pre As Presentation Dim FolderPath As String Dim pp As String Dim id As String Dim oFileDialog As FileDialog Set oFileDialog = Applicati...
阅读全文
摘要：Sub ControlInsertProduct() Dim Wb As Workbook Dim OneSht As Worksheet Dim Arr As Variant Dim i As Long Arr = Array("农家香菜籽油（20L）", "万家炊大豆油（20L）", "万家炊原香菜籽油（20L）", "压榨菜籽油（20L）") ...
阅读全文
摘要：Sub NextSeven_CodeFrame() '应用程序设置 Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual '错误处理 On Error GoTo ErrHandle...
阅读全文
摘要：Sub NextSeven_CodeFrame() '应用程序设置 Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual '错误处理 On Error GoTo ErrHandl...
阅读全文
摘要：Const ModelText As String = "机构名称" Const ModelName As String = "测试文件.pptx" Sub NextSeven_CodeFrame() '应用程序设置 Application.ScreenUpdating = False Application.DisplayAlerts = False Appl...
阅读全文
摘要：Sub NextSeven_CodeFrame() '应用程序设置 Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual '错误处理 'On Error GoTo ErrHandl...
阅读全文
摘要：Sub NextSeven_CodeFrame() '应用程序设置 Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual '错误处理 On Error GoTo ErrHandle...
阅读全文
摘要：Sub NextSeven_CodeFrame() '应用程序设置 Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual '错误处理 On Error GoTo ErrHandle...
阅读全文
摘要：Sub InsertToDataBase() Dim DataPath As String Dim SQL As String Const DataName As String = "yunying.mdb" Const TableName As String = "关键词效果分析" DataPath = ThisWorkbook.Path & "\"...
阅读全文
摘要：Public Sub 多个区域拆分到多表() AppSettings On Error GoTo ErrHandler Dim StartTime, UsedTime As Variant StartTime = VBA.Timer 'Input code here Dim Wb As Workbook Dim sht As Workshe...
阅读全文
摘要：Sub NextSeven_CodeFrame() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.StatusBar = ">>>>>>>>程序正在运行>>>...
阅读全文
摘要：Dim Rng As Range Dim Arr As Variant Dim LastCell As Range Dim FindText As String Dim ItemCount As Long Dim Dic As Object Private Sub CbOption_Change() FindText = CbOption.Text If Len(FindText...
阅读全文
摘要：Public Sub Basic_CodeFrame() AppSettings On Error GoTo ErrHandler Dim StartTime, UsedTime As Variant StartTime = VBA.Timer 'Input code here Call SubTotalData UsedTime = ...
阅读全文
摘要：Sub RegExpSubtotal() '声明变量 Dim Regex As Object '正则对象 Dim Dic As Object '字典对象 Dim Key As String '关键字 Dim Item As Double '项内容 Dim Index As Long '序号 Dim Text As String '文本 ...
阅读全文
摘要：Public Sub QqYunContactTransferCsvFile() '应用程序设置 Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual '错误处理 'On Erro...
阅读全文
摘要：Public Sub GetFirst() GetDataFromWord "初检" End Sub Public Sub GetDataFromWord(ByVal SheetName As String) AppSettings 'On Error GoTo ErrHandler Dim StartTime, UsedTime As Variant ...
阅读全文
摘要：Public Sub MakeUp() Dim Sht As Worksheet Set Sht = ThisWorkbook.Worksheets("设置") Dim Total As Double Dim iMin As Double, iMax As Double Dim RndNum As Long Dim RndRow As Long...
阅读全文
摘要：Sub NextSeven_CodeFrame() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.StatusBar = ">>>>>>>>程序正在运行>>>...
阅读全文
摘要：Sub NextSeven_CodeFrame4() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.StatusBar = ">>>>>>>>程序正在运行>>...
阅读全文
摘要：Sub AddPovitTable() 'Constance Const DATA_SHEET As String = "Advanced Filter" Const DATA_ADDRESS As String = "R7C1:R107C11" Const PIVOT_SHEET As String = "PivotSheet" ' Sheet Name ...
阅读全文
摘要：Public Sub SubtotalData() AppSettings 'On Error GoTo ErrHandler Dim StartTime, UsedTime As Variant StartTime = VBA.Timer 'Input code here Dim Wb As Workbook Dim Sht As Wo...
阅读全文
摘要：Sub 跨表转置() Dim Wb As Workbook Dim Sht As Worksheet Dim oSht As Worksheet Dim Rng As Range Dim Index As Long Const HeadRow As Long = 12 Set Wb = Application.ThisWorkbook ...
阅读全文
摘要：Sub mainProc() Application.ScreenUpdating = False Application.DisplayAlerts = wdAlertsNone 'Dim xlApp As Excel.Application 'Dim Wb As Excel.Workbook 'Dim Sht As Excel.Worksheet ...
阅读全文
摘要：Public Sub Basic_CodeFrame() AppSettings 'On Error GoTo ErrHandler Dim StartTime, UsedTime As Variant StartTime = VBA.Timer 'Input code here Dim Wb As Workbook Dim Sht As...
阅读全文
摘要：Public Sub GatherDataPicker() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.StatusBar = ">>>>>>>>程序正在运...
阅读全文
摘要：Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type GdiplusStartupInput GdiplusVersion As Long DebugEventCallback As ...
阅读全文
摘要：Public Sub GetContents() Dim Reg As Object Dim Matches As Object Dim OneMatch As Object Dim Index As Long Dim TimeStart As Variant TimeStart = VBA.Timer Set Reg = CreateOb...
阅读全文
摘要：Sub 获取OutLook收件箱主题和正文() On Error Resume Next Dim sht As Worksheet Dim olApp As Outlook.Application Dim olMail As Outlook.MailItem Dim olNameSpace As Outlook.Namespace Dim OneF...
阅读全文
摘要：Public Sub NextSeven_CodeFrame() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.StatusBar = ">>>>>>>>程序...
阅读全文
摘要：Sub NextSeven_CodeFrame() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.StatusBar = ">>>>>>>>程序正在运行>>>...
阅读全文
摘要：Public Sub GatherDataPicker() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.StatusBar = ">>>>>>>>程序正在运...
阅读全文
摘要：Public Sub StartRecursionFolder() Dim Pre As Presentation Dim FolderPath As String Dim pp As String Dim id As String Dim oFileDialog As FileDialog Set oFileDialog = Applicatio...
阅读全文
摘要：Sub NextSeven20170706001() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.StatusBar = ">>>>>>>>程序正在运行>>...
阅读全文
摘要：Public Sub GatherFilesData() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculationManual Application.StatusBar = ">>>>>>>>程序正在运行...
阅读全文
摘要：单位里普遍存在各种低效率的办公行为，比如每年的自我评分。评分细目表为word文档，每行一个项目，每个项目要填写得分事项和分值，组长审核之后转成Excel向上递交。主要涉及到问题就是word文档中一列得分要转成Excel一行内容，如果一个人就复制，粘贴到Excel，再复制，转置即可。人一多，显得很麻烦
阅读全文
摘要：因为工作需要，经常需要到新浪某博客去找资料，在博文目录里一页页地肉眼搜索，看到合适的标题再点击开链接查看内容，知道合适地再复制下来。很烦人。于是一直有个想法，学会爬虫。 拿着单位发的购书卡去买了本入门的书《python编程从入门到实践》，凭着一点编程的底子，三个小时看完了基础部分，然后安装pytho
阅读全文
浙公网安备 33010602011771号