麻辣家族討論版版 - Powered by Discuz! Board

Function PutRowData(strData As String, strSheets As String, strCol As String)
'塞資料到指定欄位，並放到該欄的最後空白列
'資料串由Tab字元自動切開，放置不同欄的資料到不同欄位裡
'
'strData 資料串
'strSheets 指定工作表
'strCol 指定欄位（英文字）
Dim objDes As Object
Set objDes = Sheets(strSheets)
iNewRow = objDes.Range(strCol & "65535").End(xlUp).Row + 1
If iNewRow = 2 Then
objDes.Columns("A:B").ColumnWidth = 23
objDes.Columns("C").ColumnWidth = 8
objDes.Columns("D").ColumnWidth = 29
objDes.Columns("E:P").ColumnWidth = 8
objDes.Columns("Q").ColumnWidth = 29
'objDes.Columns("A:Q").EntireColumn.AutoFit
Title = "種類"
tmpTitle = Split(Title, ",")
For intI = 0 To UBound(tmpTitle)
intC = intI + 1
objDes.Range(strCol & "2").Offset(0, intC) = tmpTitle(intI)
Next
iNewRow = iNewRow + 3
End If
tmp = Split(strData, ",")
For i = 0 To UBound(tmp)
If i = 16 Then '第16個陣列值取26個字元 = 00 00 00 00 00 00 00 00 00 00
objDes.Range(strCol & iNewRow).Offset(0, i) = Mid(tmp(i), 1, 29)
Else
objDes.Range(strCol & iNewRow).Offset(0, i) = tmp(i)
End If
Next
End Function
Public Function ReadATextFileToEOF(strKeyWord As String, Optional strPath As String, Optional strFileType As String = "*.*")
'讓user選擇純文字檔，打開檔案後，逐行搜尋，找到關鍵字，就把資料放到現在的工作表內
'變數說明
'strKeyWord 關鍵字
'strPath 預設開啟路徑
'strFileType 檔案類型 *.txt 或其他
'
Dim intFile As Integer
Dim strFile As String
Dim strIn As String
Dim bnFound As Boolean
booFound = False
strOut = vbNullString
intFile = FreeFile()
Range("A1:IV65536").ClearContents '清除表格資料
Dim fd As FileDialog, FileName As String, FileFolder As String
Set fd = Application.FileDialog(3)
With fd
.Filters.Clear
.Filters.Add "All Text Files", "*.txt"
.AllowMultiSelect = False
If .Show = -1 Then
strFile = .SelectedItems(1) '#1
Else
End
End If
End With
MsgBox "您的檔案路徑如下" & vbCrLf & strFile
'strFile = "d:\1231.txt"
'使用Open方式開啟純文字檔(不支援UTF8)
Open strFile For Input As #intFile
i = 0
Do While Not EOF(intFile)
Line Input #intFile, strIn '依照「行」來讀取資料
i = i + 1
j = InStr(strIn, strKeyWord) '使用InStr字串搜尋，有找到關鍵字，就帶入到工作表中
If j > 0 Then
'Call PutRowData("「" & strKeyWord & "」在第 " & i & "行，第 " & j & "字元," & Mid(strIn, j, 170), ActiveSheet.Name, "B")
Call PutRowData(Mid(strIn, j, 170), ActiveSheet.Name, "A")
'MsgBox (strIn)
bnFound = True
End If
Loop
Close #intFile
If bnFound = False Then
MsgBox "找不到關鍵字！"
End If
End Function
Sub 按鈕2_Click()
Call ReadATextFileToEOF("種類:肉品", "", "*.txt")
End Sub

複製代碼