vba处理excel

Posted runningzz

tags:

篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了vba处理excel相关的知识，希望对你有一定的参考价值。

#--------------------------------V1-------------------------------------#
Sub test()
With Sheets("Change Notice")
totalRow = Application.CountA(.Range("A:A"))
‘MsgBox TotalRow
startRow = 2
For i = startRow To totalRow
arr = 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").Value
Next j
Next i
End With
End Sub
#--------------------------------V2-------------------------------------#
Sub test()
With Sheets("Change Notice")
totalRow = Application.CountA(.Range("A:A"))
‘MsgBox TotalRow
startRow = 2
For 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 = host
Next i
End With
End Sub

Sub 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 i
End With
End Sub


#-------------------------------------V3-----------------------------#
Sub test()
With Sheets("Change Notice")

Worksheets.Add().Name = "RESULT"
totalRow = Application.CountA(.Range("A:A"))
‘MsgBox TotalRow
startRow = 2
For 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 If
Next i
End With
End Sub
#-----------------------------V4----------------------------------------------#
‘#--------------20160304 修复Host字段为空--------------------------------------#
‘#--------------20140304 修复Instr函数 不能判断0-----------------------------------#
Sub test()
With Sheets("Change Notice")
Worksheets.Add().Name = "RESULT"
totalRow = Application.CountA(.Range("A:A"))
‘MsgBox TotalRow
startRow = 2
Dim arrTimeStart() As String
Dim arrTimeEnd() As String
Dim arrURL() As String
Dim temp As String
Dim TEMPT As String
For 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 If
Next i
End With
End 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 = 0
End 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 TotalRow
startRow = 2
Dim arrTimeStart() As String
Dim arrTimeEnd() As String
Dim arrURL() As String
Dim temp As String
Dim TEMPT As String
Dim containNetwork As String
For 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 If
Next i
End With
End 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 = 0
End Function

#----------------------EOPS-------------------------------------------#
Sub test()
With Sheets("SQL Results")
Worksheets.Add().Name = "RESULT"
totalRow = Application.CountA(.Range("B:B"))
startRow = 2
Dim arrTimeStart() As String
Dim arrTimeEnd() As String
Dim arrURL() As String
Dim temp As String
Dim TEMPT As String
Dim containNetwork As String
For 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 i
End With
End 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 = 0
End Function

 

以上是关于vba处理excel的主要内容，如果未能解决你的问题，请参考以下文章

Excel VBA入门: 代码调试/错误处理/代码优化

在 Excel VBA 代码中处理 XMLHttp 响应中的 JSON 对象

VBA Excel 简单错误处理

Excel-VBA操作文件的四大方法

Excel-VBA操作文件四大方法之一

VBA 在 Excel 2016 中以不同方式处理日期？有这方面的文件吗？