vba导入txt文件并且进行数据对比

Private Sub CommandButton1_Click()
 Set fileDlg = Application.FileDialog(msoFileDialogFolderPicker)
  With fileDlg
      If .Show = -1 Then
         Sheet10.TextBox1.Text = .SelectedItems(1)
'           For Each fld In .SelectedItems
'                MsgBox fld
'           Next fld
      End If
  End With
      
End Sub

Private Sub CommandButton2_Click()
    Dim lngCount As Long
    Dim txb As Variant
    
    Set txb = Sheet10.TextBox2
 
    ' Open the file dialog
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
 
        ' Display paths of each file selected
        For lngCount = 1 To .SelectedItems.Count
            
            txb.Text = .SelectedItems(lngCount)
'            MsgBox .SelectedItems(lngCount)
        Next lngCount
 
    End With
    
End Sub

Private Sub CommandButton3_Click()
   Set fileDlg = Application.FileDialog(msoFileDialogFolderPicker)
  With fileDlg
      If .Show = -1 Then
           For Each fld In .SelectedItems
                Sheet10.TextBox3.Text = fld
           Next fld
      End If
  End With

End Sub

Private Sub CommandButton4_Click()
  Call log_clear
  Call get_log
End Sub
Sub get_log()

    Dim stA, arr(), arr2(), s$
    Dim sht, xsht As Worksheet
    Dim f As String
    Dim file() As String
    Dim x
    Dim str As Variant
    Dim str1 As Variant
    Dim str2 As Variant
    Dim arr3(1, 2) As Variant
    Dim arr5, arr6, Brr, Drr, i&, j&, Lrw&, myDate As Date, myMin As Double
    Dim sfile As String
    Dim arrtemp() As Variant
    Dim wbA As Workbook
    Dim lstr As String
    
    
    
    Set ddd = CreateObject("scripting.dictionary")
    Set wbA = Workbooks.Open(Sheet10.TextBox2.Text)

    ReDim Preserve arr(1 To wbA.Sheets.Count)
    
    x = 1

    For Each sht In wbA.Sheets
        
        s = sht.Name
       
        
        ReDim file(1)
        
        file(1) = Sheet10.TextBox1.Text & "\"

        str = Replace(s, "#", "")
        

        f = Dir(file(1) & "*.log")
        
        
    
        Do Until f = ""
            str1 = Left(Split(Split(f, "\")(UBound(Split(f, "\"))), ".")(0), Len(Split(Split(f, "\")(UBound(Split(f, "\"))), ".")(0)) - 13)
            
            If InStr(str1, "_") > 0 Then
               str2 = Split(str1, "_")(1)
            Else
               str2 = str1
            End If
            
            If str = str2 Then
                ReDim Preserve arr2(1 To 2, 1 To x)
                arr2(1, x) = s
                arr2(2, x) = file(i) & f
'                ReDim Preserve arr2(1 To x)
'                arr2(x) = file(i) & f
                x = x + 1
            End If
    
            f = Dir
    
        Loop
        
        
        
        
    Next
    
    


   
For l = 1 To UBound(arr2, 1)
        sfile = arr2(2, l)
        ReDim Drr(1 To 1, 1 To 9)
        
        Open Sheet10.TextBox1.Text & "\" & sfile For Input As #1

        arr5 = Split(Input$(LOF(1), #1), vbCrLf)
        Close #1
        
        lstr = arr5(0)
        
        If StrComp(Replace(lstr, vbLf, ""), "hostname") = 0 Then
        
          Set xsht = wbA.Sheets.Add(after:=Sheets(wbA.Sheets.Count))
          xsht.Name = Left(sfile, Len(sfile) - 17)
          
          Call addsheet(xsht, Sheet10.TextBox1.Text & "\" & sfile)
          
          Call test3(wbA.Sheets(arr2(1, l)), xsht)

        End If
        
   Next l
   
   wbA.Save
   wbA.Close
   
End Sub


Function addsheet(sht As Worksheet, sfile As Variant)

With sht.QueryTables.Add(Connection:="TEXT;" & sfile & "", Destination:=sht.Range("$A$1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileOtherDelimiter = ":"
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Function


Sub test3(sht1 As Worksheet, sht2 As Worksheet)
  
  Dim arr22, arr3 As Variant
  Dim rowno As Variant
  
  rowno = 17
  
  
  arr22 = sht1.Range("B4:C" & sht1.Range("B4").End(xlDown).Row).Value
  arr3 = sht2.Range("A1:D" & sht2.Range("A1").End(xlDown).Row).Value

  For i = 1 To UBound(arr22, 1)
    NG_flg = True
    For j = 1 To UBound(arr3, 1)
      If arr22(i, 1) = arr3(j, 4) Then
        arr22(i, 2) = "OK"
        NG_flg = False
        sht1.Range("C" & i + 3).Interior.ColorIndex = 1
        Exit For
      End If
    Next j

    If NG_flg = True Then
      arr22(i, 2) = "NG"
      sht1.Range("C" & i + 3).Interior.ColorIndex = 3
    End If
  Next i

  sht1.Range("C4").Resize(UBound(arr22, 1), 1) = Application.Index(arr22, 0, 2)
'  If 1 Then
'    Sheet10.Range("C" & rowno).Value = sht1.Name & " NG"
'      rowno = rowno + 1
'  End If

End Sub


Sub log_clear()
  
  Sheet10.Columns("C").ClearContents
End Sub
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值