vba处理excel-白红宇

vba处理excel
阅读量：4562 次
发布时间：2019-06-08
本文共 14298 字，大约阅读时间需要 47 分钟。
#--------------------------------V1-------------------------------------#Sub test()With Sheets("Change Notice")totalRow = Application.CountA(.Range("A:A"))'MsgBox TotalRowstartRow = 2For i = startRow To totalRowarr = Split(.Cells(i, "d").Text, Chr(10))arrTimeStart = Split(Format(.Cells(i, "b"), "yyyymmdd hhmmss"), " ")arrTimeEnd = Split(Format(.Cells(i, "c"), "yyyymmdd hhmmss"), " ")'MsgBox (Format(.Cells(i, "b"), "yyyymmdd hhmmss"))For j = 0 To UBound(arr)    'Sheets("RESULT").Range("A65536").End(xlUp).Offset(1, 0).Value = .Cells(i, "A").Value    Sheets("RESULT").Range("B65536").End(xlUp).Offset(1, 0).Value = arrTimeStart(0)    Sheets("RESULT").Range("C65536").End(xlUp).Offset(1, 0).Value = arrTimeStart(1)    Sheets("RESULT").Range("D65536").End(xlUp).Offset(1, 0).Value = arrTimeEnd(0)    Sheets("RESULT").Range("E65536").End(xlUp).Offset(1, 0).Value = arrTimeEnd(1)    Sheets("RESULT").Range("F65536").End(xlUp).Offset(1, 0).Value = arr(j)    Sheets("RESULT").Range("G65536").End(xlUp).Offset(1, 0).Value = .Cells(i, "E").Value    Sheets("RESULT").Range("H65536").End(xlUp).Offset(1, 0).Value = .Cells(i, "F").Value    Sheets("RESULT").Range("I65536").End(xlUp).Offset(1, 0).Value = .Cells(i, "G").ValueNext jNext iEnd WithEnd Sub#--------------------------------V2-------------------------------------#Sub test()With Sheets("Change Notice")totalRow = Application.CountA(.Range("A:A"))'MsgBox TotalRowstartRow = 2For i = startRow To totalRow    'd列表示的是CI那一列，将其拆成一个数组    arr = Split(.Cells(i, "d").Text, Chr(10))    '初始化时间，变更号等信息        arrTimeStart = Split(Format(.Cells(i, "b"), "yyyymmdd hhmmss"), " ") 'b列----开始时间    arrTimeEnd = Split(Format(.Cells(i, "c"), "yyyymmdd hhmmss"), " ") 'c列---结束时间    Sheets("RESULT").Range("A:E").NumberFormatLocal = "@"    Sheets("RESULT").Range("A65536").End(xlUp).Offset(1, 0).Value = .Cells(i, "A").Value '赋值变更号    Sheets("RESULT").Range("B65536").End(xlUp).Offset(1, 0).Value = arrTimeStart(0)    Sheets("RESULT").Range("C65536").End(xlUp).Offset(1, 0).Value = arrTimeStart(1)    Sheets("RESULT").Range("D65536").End(xlUp).Offset(1, 0).Value = arrTimeEnd(0)    Sheets("RESULT").Range("E65536").End(xlUp).Offset(1, 0).Value = arrTimeEnd(1)    'CI 名初始化为空    host = ""    For j = 0 To UBound(arr) '开始遍历CI数组        LTrim (RTrim(arr(j))) '去除开头和末尾的空格        '新增arr2 数组用处理空格 tab等键        arr2 = Split(arr(j), " ")        '如果数组不为空        If (UBound(arr2) > 0) Then            For k = 0 To UBound(arr2)                LTrim (RTrim(arr2(k)))                If (host = "" And arr2(k) <> "") Then '如果host是初值以及arr2第一个值不为空则直接赋值                    host = arr2(j)                ElseIf (arr2(k) <> "") Then '否则拼接                    host = host & "," & arr2(k)                End If            Next k        Else            If (host = "" And arr(j) <> "") Then             host = arr(j)            ElseIf (arr(j) <> "") Then                host = host & "," & arr(j)            End If        End If    Next j    '将处理完毕的host赋值给RESULT表    Sheets("RESULT").Range("F65536").End(xlUp).Offset(1, 0).Value = hostNext iEnd WithEnd SubSub URL()With Sheets("Change Notice")    totalRow = Application.CountA(.Range("A:A"))    startRow = 2    For i = startRow To totalRow        'd列表示的是CI那一列，将其拆成一个数组        arr = Split(.Cells(i, "f").Text, Chr(10))        For j = 0 To UBound(arr)            If (InStr(LCase(arr(j)), "http")) Then                arr(j) = Replace(arr(j), ";", "")                arr(j) = Replace(arr(j), "；", "")                LTrim (RTrim(arr(j)))                MsgBox arr(j)                a = arr(j)            End If        Next j    Next iEnd WithEnd Sub#-------------------------------------V3-----------------------------#Sub test()With Sheets("Change Notice")Worksheets.Add().Name = "RESULT"totalRow = Application.CountA(.Range("A:A"))'MsgBox TotalRowstartRow = 2For i = startRow To totalRow    arr = Split(.Cells(i, "d").Text, Chr(10))    arrURL = Split(.Cells(i, "f").Text, Chr(10))    arrTimeStart = Split(Format(.Cells(i, "b"), "yyyymmdd hhmmss"), " ")    arrTimeEnd = Split(Format(.Cells(i, "c"), "yyyymmdd hhmmss"), " ")    Sheets("RESULT").Range("A:G").NumberFormatLocal = "@"    URL = .Cells(i, "F").Text        For j = 0 To UBound(arr)        '变更号        Sheets("RESULT").Range("B65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim((.Cells(i, "A").Value)))        Sheets("RESULT").Range("B65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim((.Cells(i, "A").Value)))        '开始日期        Sheets("RESULT").Range("D65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeStart(0)))        Sheets("RESULT").Range("D65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeStart(0)))        '开始时间        Sheets("RESULT").Range("E65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeStart(1)))        Sheets("RESULT").Range("E65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeStart(1)))        '结束日期        Sheets("RESULT").Range("F65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeEnd(0)))        Sheets("RESULT").Range("F65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeEnd(0)))        '结束时间        Sheets("RESULT").Range("G65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeEnd(1)))        Sheets("RESULT").Range("G65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeEnd(1)))                'CI        Sheets("RESULT").Range("A65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arr(j)))        Sheets("RESULT").Range("A65536").End(xlUp).Offset(1, 0).Value = "*" '用来屏蔽URL（当object字段里包含了）        'URL        Sheets("RESULT").Range("C65536").End(xlUp).Offset(1, 0).Value = "*"        Sheets("RESULT").Range("C65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arr(j)))    Next j    If (InStr(LCase(URL), "http")) Then        For k = 0 To UBound(arrURL)            If (InStr(LCase(arrURL(k)), "http")) Then                arrURL(k) = Replace(arrURL(k), "；", "")                'MsgBox (InStr(arrURL(k)))                arrURL(k) = Mid(arrURL(k), InStr(arrURL(k), "http"), Len(arrURL(k))) '去除开头的非法字符                                '变更号                Sheets("RESULT").Range("B65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(.Cells(i, "A").Value))                '开始日期                Sheets("RESULT").Range("D65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeStart(0)))                '开始时间                Sheets("RESULT").Range("E65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeStart(1)))                '结束日期                Sheets("RESULT").Range("F65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeEnd(0)))                '结束时间                Sheets("RESULT").Range("G65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrTimeEnd(1)))                'CI                Sheets("RESULT").Range("A65536").End(xlUp).Offset(1, 0).Value = "*"                'URL                Sheets("RESULT").Range("C65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrURL(k)))            End If        Next k    End IfNext iEnd WithEnd Sub#-----------------------------V4----------------------------------------------#'#--------------20160304 修复Host字段为空--------------------------------------#'#--------------20140304 修复Instr函数 不能判断0-----------------------------------#Sub test()With Sheets("Change Notice")Worksheets.Add().Name = "RESULT"totalRow = Application.CountA(.Range("A:A"))'MsgBox TotalRowstartRow = 2Dim arrTimeStart() As StringDim arrTimeEnd() As StringDim arrURL() As StringDim temp As StringDim TEMPT As StringFor i = startRow To totalRow    arr = Split(.Cells(i, "d").Text, Chr(10))    arrURL = Split(.Cells(i, "f").Text, Chr(10))    arrTimeStart = Split(Format(.Cells(i, "b"), "yyyymmdd hhmmss"), " ")    arrTimeEnd = Split(Format(.Cells(i, "c"), "yyyymmdd hhmmss"), " ")    Sheets("RESULT").Range("A:G").NumberFormatLocal = "@"    URL = .Cells(i, "F").Text        For j = 0 To UBound(arr)        temp = arr(j)        If (Len(temp) > 2) Then '去除为空的            idnit = Init(.Cells(i, "A").Value, arrTimeStart(0), arrTimeStart(1), arrTimeEnd(0), arrTimeEnd(1), temp, "*") '设置Host 字段            idnit = Init(.Cells(i, "A").Value, arrTimeStart(0), arrTimeStart(1), arrTimeEnd(0), arrTimeEnd(1), "*", temp) '设置URL(Object)字段        End If    Next j    If (InStr(LCase(URL), "http")) Then        For k = 0 To UBound(arrURL)            If (InStr(LCase(arrURL(k)), "http")) Then                arrURL(k) = Replace(arrURL(k), "；", "")                'MsgBox (InStr(arrURL(k)))                TEMPT = Mid(arrURL(k), (InStr(LCase(arrURL(k)), "http")), Len(arrURL(k))) '去除开头的非法字符 Mid 函数不能以0开头               idnit = Init(.Cells(i, "A").Value, arrTimeStart(0), arrTimeStart(1), arrTimeEnd(0), arrTimeEnd(1), "*", TEMPT) '设置Object 的Host            End If        Next k    End IfNext iEnd WithEnd Sub'初始化函数Function Init(changeID As String, arrStart_0 As String, arrStart_1 As String, arrEnd_0 As String, arrEnd_1 As String, CI As String, URL As String)    '变更号    Sheets("RESULT").Range("B65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(changeID))    '开始日期    Sheets("RESULT").Range("D65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrStart_0))    '开始时间    Sheets("RESULT").Range("E65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrStart_1))    '结束日期    Sheets("RESULT").Range("F65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrEnd_0))    '结束时间    Sheets("RESULT").Range("G65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrEnd_1))    'CI    Sheets("RESULT").Range("A65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(CI))    'URL    Sheets("RESULT").Range("C65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(URL))    Init = 0End Function----------------------------------------------------------------V6---------------------------------------'#--------------20160304 修复Host字段为空--------------------------------------#'#--------------20140304 修复Instr函数 不能判断0-----------------------------------#'#--------------20160318 增加只对包含URL的变更做object处理----------------------#'#--------------20160318 修改为只对非网络类变更做object处理----------------------#Sub test()With Sheets("Change Notice")Worksheets.Add().Name = "RESULT"totalRow = Application.CountA(.Range("A:A"))'MsgBox TotalRowstartRow = 2Dim arrTimeStart() As StringDim arrTimeEnd() As StringDim arrURL() As StringDim temp As StringDim TEMPT As StringDim containNetwork As StringFor i = startRow To totalRow    arr = Split(.Cells(i, "d").Text, Chr(10))    arrURL = Split(.Cells(i, "f").Text, Chr(10))    arrTimeStart = Split(Format(.Cells(i, "b"), "yyyymmdd hhmmss"), " ")    arrTimeEnd = Split(Format(.Cells(i, "c"), "yyyymmdd hhmmss"), " ")    Sheets("RESULT").Range("A:G").NumberFormatLocal = "@"    URL = .Cells(i, "F").Text    containNetwork = .Cells(i, "G")    For j = 0 To UBound(arr)        temp = arr(j)        If (Len(temp) > 2) Then '去除为空的            idnit = Init(.Cells(i, "A").Value, arrTimeStart(0), arrTimeStart(1), arrTimeEnd(0), arrTimeEnd(1), temp, "*") '设置Host 字段            '只有非网络的才设置Object            If (containNetwork <> "网络") Then                idnit = Init(.Cells(i, "A").Value, arrTimeStart(0), arrTimeStart(1), arrTimeEnd(0), arrTimeEnd(1), "*", temp) '设置URL(Object)字段            End If        End If    Next j    If (InStr(LCase(URL), "http") > 0) Then        For k = 0 To UBound(arrURL)            If (InStr(LCase(arrURL(k)), "http") > 0) Then                arrURL(k) = Replace(arrURL(k), "；", "")                TEMPT = Mid(arrURL(k), (InStr(LCase(arrURL(k)), "http")), Len(arrURL(k))) '去除开头的非法字符 Mid 函数 起始位置不能是0                idnit = Init(.Cells(i, "A").Value, arrTimeStart(0), arrTimeStart(1), arrTimeEnd(0), arrTimeEnd(1), "*", TEMPT) '设置Object 的Host            End If        Next k    End IfNext iEnd WithEnd Sub'初始化函数Function Init(changeID As String, arrStart_0 As String, arrStart_1 As String, arrEnd_0 As String, arrEnd_1 As String, CI As String, URL As String)    '变更号    Sheets("RESULT").Range("B65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(changeID))    '开始日期    Sheets("RESULT").Range("D65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrStart_0))    '开始时间    Sheets("RESULT").Range("E65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrStart_1))    '结束日期    Sheets("RESULT").Range("F65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrEnd_0))    '结束时间    Sheets("RESULT").Range("G65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrEnd_1))    'CI    Sheets("RESULT").Range("A65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(CI))    'URL    Sheets("RESULT").Range("C65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(URL))    Init = 0End Function#----------------------EOPS-------------------------------------------#Sub test()With Sheets("SQL Results")Worksheets.Add().Name = "RESULT"totalRow = Application.CountA(.Range("B:B"))startRow = 2Dim arrTimeStart() As StringDim arrTimeEnd() As StringDim arrURL() As StringDim temp As StringDim TEMPT As StringDim containNetwork As StringFor i = startRow To totalRow    arr = Split(.Cells(i, "j").Text, ";")    'arrURL = Split(.Cells(i, "f").Text, Chr(10))    arrTimeStart = Split(Format(.Cells(i, "f"), "yyyymmdd hhmmss"), " ")    arrTimeEnd = Split(Format(.Cells(i, "g"), "yyyymmdd hhmmss"), " ")    Sheets("RESULT").Range("A:G").NumberFormatLocal = "@"    For j = 0 To UBound(arr)        temp = arr(j)        If (Len(temp) > 2) Then '去除为空的            idnit = Init(.Cells(i, "b").Value, arrTimeStart(0), arrTimeStart(1), arrTimeEnd(0), arrTimeEnd(1), temp, "*") '设置Host 字段        End If    Next j    Next iEnd WithEnd Sub'初始化函数Function Init(changeID As String, arrStart_0 As String, arrStart_1 As String, arrEnd_0 As String, arrEnd_1 As String, CI As String, URL As String)    '变更号    Sheets("RESULT").Range("B65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(changeID))    '开始日期    Sheets("RESULT").Range("D65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrStart_0))    '开始时间    Sheets("RESULT").Range("E65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrStart_1))    '结束日期    Sheets("RESULT").Range("F65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrEnd_0))    '结束时间    Sheets("RESULT").Range("G65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(arrEnd_1))    'CI    Sheets("RESULT").Range("A65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(CI))    'URL    Sheets("RESULT").Range("C65536").End(xlUp).Offset(1, 0).Value = LTrim(RTrim(URL))    Init = 0End Function
转载于:https://www.cnblogs.com/runningzz/p/6782845.html
你可能感兴趣的文章
5.13Js练习题
查看>>
mysql系列之8.mysql高可用 (mha4mysql)
查看>>
DIY_DE2之DM9000A网卡调试系列例程（二）——DM9000A测试、自收发、实现UDP
查看>>
配置远程连接mysql数据库 Connect to remote mysql database
查看>>
HDU 5374 Tetris （2015年多校比赛第7场）
查看>>