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
vba导入txt文件并且进行数据对比
于 2019-10-25 06:43:23 首次发布