[已解决]求助!!文本数据提取,按照时间规律与字眼提取

coco_lin

MfbAspJ2.rar (7.19 KB, 下载次数: 8)

2010-2-8 02:57 上传

点击文件名下载附件
求助!!文本数据提取,按照时间规律与字眼提取

附件中是我想做成的效果

按照时间规律将数据中不包含"OK"数据提取到B列的设备情况 将含有"ok"字眼的数据放入C列的处理情况,,请高人帮我编辑个宏..谢谢

最佳答案

月排行榜 / 总排行榜

amulee

2010-2-8 09:34

Sub 读取()
    Dim fso As Object
    Dim objTxt As Object
    Dim strFileName As String
    Dim ArrYS, ArrJG, i&, Temp&, j&
    strFileName = ThisWorkbook.Path & "\11.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objTxt = fso.OpenTextFile(strFileName)
    ArrYS = Split(objTxt.readall, vbCrLf)
    objTxt.Close
    Set objTxt = Nothing
    Set fso = Nothing
    Range("B3:C33").ClearContents
    ArrJG = Range("B3:C33")
    For i = 0 To UBound(ArrYS)
        Temp = Day(Split(ArrYS(i), ",")(0))
        If InStr(1, ArrYS(i), "OK", vbTextCompare) > 0 Then
            ArrJG(Temp, 2) = ArrJG(Temp, 2) & Chr(10) & ArrYS(i)
        Else
            ArrJG(Temp, 1) = ArrJG(Temp, 1) & Chr(10) & ArrYS(i)
        End If
    Next i
    For i = 1 To UBound(ArrJG, 1)
        For j = 1 To 2
            If Len(ArrJG(i, j)) > 0 Then
                ArrJG(i, j) = Right(ArrJG(i, j), Len(ArrJG(i, j)) - 1)
            End If
        Next j
    Next i
    Range("B3:C33") = ArrJG
End Sub

跳转到最佳答案楼层

gdw2005

不会做，帮你顶顶。

amulee

Sub 读取()
    Dim fso As Object
    Dim objTxt As Object
    Dim strFileName As String
    Dim ArrYS, ArrJG, i&, Temp&, j&
    strFileName = ThisWorkbook.Path & "\11.txt"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objTxt = fso.OpenTextFile(strFileName)
    ArrYS = Split(objTxt.readall, vbCrLf)
    objTxt.Close
    Set objTxt = Nothing
    Set fso = Nothing
    Range("B3:C33").ClearContents
    ArrJG = Range("B3:C33")
    For i = 0 To UBound(ArrYS)
        Temp = Day(Split(ArrYS(i), ",")(0))
        If InStr(1, ArrYS(i), "OK", vbTextCompare) > 0 Then
            ArrJG(Temp, 2) = ArrJG(Temp, 2) & Chr(10) & ArrYS(i)
        Else
            ArrJG(Temp, 1) = ArrJG(Temp, 1) & Chr(10) & ArrYS(i)
        End If
    Next i
    For i = 1 To UBound(ArrJG, 1)
        For j = 1 To 2
            If Len(ArrJG(i, j)) > 0 Then
                ArrJG(i, j) = Right(ArrJG(i, j), Len(ArrJG(i, j)) - 1)
            End If
        Next j
    Next i
    Range("B3:C33") = ArrJG
End Sub

coco_lin

谢谢amulee