Offices & Vba ’ 目录归档

【VBA】【Office宏】将数据按类分到不同 sheet

说明:
正好用到,翻了一下以前的收藏,发现有这么个 vba,正好拿来使用。Excel 365 for Mac 测试通过。
1. 先讲 sheet 第一列中的项目分类 排序;
2. 宏将 把分类中相同值的行数据复制到一个新的 sheet,sheet name 就是分类的名称;

CODE:

Function Rows_Split()
  Dim Rcount As Long, OldRow As Long
  Dim DataSheet As Worksheet
  Dim tSplit As String
  Dim Tx As String

  Set DataSheet = ActiveSheet
  Recount = ActiveSheet.Range("A65535").End(xlUp).Row + 1
  For Nx = 2 To Recount
      Tx = DataSheet.Cells(Nx, 1).Value  '第一栏为要分的类
      If Tx <> tSplit Then
         If OldRow <> 0 Then
            Debug.Print OldRow
            DataSheet.Rows(OldRow & ":" & Nx - 1).Copy Range("A2") '数据复制范围、
         End If

         If Tx <> vbNullString Then
            OldRow = Nx
            Worksheets.Add after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = Tx
            tSplit = Tx
        DataSheet.Range("A1:K1").Copy Range("A1") '标题列位置
         End If
      End If
  Next
  Set DataSheet = Nothing
End Function
  • 【VBA】【Office宏】将数据按类分到不同 sheet已关闭评论

[Excel VBA] 破解Excel工作簿保护

同事工作簿保护密码忘记了,正好找到一个,亲测有效,Excel2007通过。记录一下,以备不时之需。

Sub 破解工作薄保护()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
False, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveSheet.Unprotect
End Sub
  • [Excel VBA] 破解Excel工作簿保护已关闭评论

[Excel VBA]单元格更改后自动排序

项目正好用到,记录一下,excel 2007 测试通过。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Then
        i = Selection.Row
        j = Selection.Column

        Range("A6").Select
        Selection.Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin, DataOption1:=xlSortNormal
        Cells(i, j).Select
    End If
End Sub
  • [Excel VBA]单元格更改后自动排序已关闭评论

Excel-vlookup 逆向查询公式

Vlookup 逆向查询

  • Excel-vlookup 逆向查询公式已关闭评论

工作好帮手哦 MS Outlook VBA 宏-邮件规则

        MS Outlook 的邮件规则满了,怎么办,还有那么多邮件要分类存放、处理。。。不要怕【宏】帮你忙,可以自动回复特定邮件,可以自动存档带附件的邮件,配合其他Office中的组件,可以基本你可以不用动手就帮你把事情做完嘻嘻,别告诉老板,你使用宏做的哦,否则 嘿嘿…

        一起来尝试编制一个宏吧,可以实现收到指定发件人后,将邮件移动到指定目录等。Outlook中 【alt】+【F11】,输入如下代码:

Sub EmailFilter(Item As MailItem)
    ' 声明变量,好处是编辑器知道变量类型之后可以进行自动提示。
    Dim id As String
    Dim email As Outlook.MailItem
    Dim objApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim inbox As Outlook.MAPIFolder

    ' 取得收件夹和下面的三个子目录
    Set objApp = Application
    Set objNS = objApp.GetNamespace("MAPI")
    Set inbox = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
    id = Item.EntryID
    Set email = Application.Session.GetItemFromID(id)

    '收到主题中含有 "表扬" 字样的邮件,直接丢到已删除邮件中
    If email.Subject Like "*表扬*" Then email.Move objNS.Folders("个人文件夹").Folders("已删除邮件")

    '收到抄送自己的(或者其他重要邮件),设置标记为红色,以便快速查看
    If email.CC = "抄送自己的" Then email.FlagIcon = olRedFlagIcon

    '设置发件人,一旦符合,执行操作,可以删除,可以移动到指定文件夹(文件夹的文件夹...),可以回复,可以...
    Select Case email.SenderName
        Case "XXXXXX"
        email.Move inbox.Folders("XXX")
    End Select
End Sub

        在编辑器中保存后,切换到 Outlook 界面,点击菜单【工具】–>【规则和通知】–>【新建规则】–>【选择 从空白规则开始:邮件到达时检查】–>【条件:仅在本机】–>【动作:运行脚本,在弹出窗口中选择之前创建的脚本】–>【点击完成】

        有啥不明白的,偶们一起探讨 🙂

VBA 隐含模块中的编译错误 解决办法

在Office 2003下面编的小程序,在office 2000下无法正常运行,提示:隐含模块中的编译错误:MainForm。程序无法运行,自动退出。调试发现,一些内置函数都会报相同错误,莫名啊。
  阅读全文

  • VBA 隐含模块中的编译错误 解决办法已关闭评论

mailto邮寄地址链接 outlook点开乱码的解决方案

之前写了一个网页,使用@mailto来写了收件人,主题,正文等作为一个模板使用。编码使用gb2312(之前使用utf-8不不管怎么设置都是乱码),自己用outlook2007正常,所以就发布了。

运行了几天,一些同事反馈用outlook2003点开链接邮件显示乱码,但有的也是正常,如下图: 阅读全文

  • mailto邮寄地址链接 outlook点开乱码的解决方案已关闭评论

return top