彰化一整天的論壇

 找回密碼
 立即註冊
樓主: z22344566

Excel 如何去抓取機台每天自動產生的資料

[複製鏈接]
發表於 2017-4-26 22:54:21 | 顯示全部樓層
z22344566 發表於 2017-4-26 21:09
挖...........
那我這程式就不能用了

我已將您的問題在facebook上問陳智揚老師,若有解法再跟您說.https://www.facebook.com/permali ... ;id=100002539755801
回復 支持 反對

使用道具 舉報

發表於 2017-4-26 23:20:52 | 顯示全部樓層
z22344566 發表於 2017-4-26 21:09
挖...........
那我這程式就不能用了

您把檔案更新後,再執行後,就不會有#N/A問題,請看壓縮檔內OK.xlsm
vlookup_file.gif

1.更新後,再執行VBA就不會出現#N/A

vlookup_file.zip

35.35 KB, 下載次數: 1

售價: 1 金錢  [記錄]

回復 支持 反對

使用道具 舉報

發表於 2017-4-26 23:37:07 | 顯示全部樓層
imingho 發表於 2017-4-26 23:20
您把檔案更新後,再執行後,就不會有#N/A問題,請看壓縮檔內OK.xlsm
1.更新後,再執行VBA就不會出現#N/A
...

因為只要開啟檔案就會OK.所以我在VBA加上開啟檔案及關閉檔案的功能,就可以解決這個問題.


  1. Sub Getvalue()
  2.     Dim strYear As String
  3.     Dim nSeq As String
  4.     Filename = Format(Date, "yymmdd")
  5.     strPath = Excel.ActiveWorkbook.Path & "\" & Format(Date, "yyyy") & "\" & Format(Date, "mm") & "\" & Format(Date, "dd")
  6.    
  7.     Application.DisplayAlerts = False '關閉警告
  8.     bRun = True     '用以提前結束迴圈
  9.     nSeq = 0           '檔案序號
  10.     For i = 2 To 3
  11.         If bRun = False Then
  12.            Exit For
  13.         End If
  14.         For j = 2 To 4
  15.             If bRun = False Then
  16.                Exit For
  17.             End If
  18.             nSeq = nSeq + 1
  19.             sCheck = Excel.ActiveWorkbook.Path & "\" & Format(Date, "yyyy") & "\" & Format(Date, "mm") & "\" & Format(Date, "dd") & "\" & Filename & Format(nSeq, "0000") & ".csv"
  20.            ' MsgBox "[" & sCheck & "]", vbInformation '看檔名是否正確
  21.            If Dir(sCheck & "", vbDirectory) <> "" Then '檔案存在, 進行檢查
  22.                Workbooks.Open Filename:=sCheck
  23.                Cells(j, i).Formula = "=vlookup(A2,'" & strPath & "\[" & Filename & Format(nSeq, "0000") & ".csv]" & Filename & Format(nSeq, "0000") & "'!$A$2:$E$6,5,FALSE)"
  24.                 ActiveWindow.Close
  25.             Else                        '檔案不存在,收工
  26.                bRun = False
  27.             End If
  28.         Next j
  29.     Next i
  30.     Application.DisplayAlerts = True '開啟警告
  31. End Sub

複製代碼


tmh_ok.xlsm

17 KB, 下載次數: 2

售價: 1 金錢  [記錄]

回復 支持 反對

使用道具 舉報

 樓主| 發表於 2017-4-27 08:58:18 | 顯示全部樓層
imingho 發表於 2017-4-26 23:37
因為只要開啟檔案就會OK.所以我在VBA加上開啟檔案及關閉檔案的功能,就可以解決這個問題.

...

老師
當我執行您的程式碼時
並不會出現數值

我執行我原本的程式碼 一樣出現n/a
但再執行您的程式碼後 n/a就變數值了
所以現在解決方法就是執行兩次這樣子嗎?
回復 支持 反對

使用道具 舉報

發表於 2017-4-27 09:17:44 | 顯示全部樓層
z22344566 發表於 2017-4-27 08:58
老師
當我執行您的程式碼時
並不會出現數值

程式碼有一段前後順序要改一下.我修改過了.您再執行看看.


  1. Sub Getvalue()
  2.     Dim strYear As String
  3.     Dim nSeq As String
  4.     Filename = Format(Date, "yymmdd")
  5.     strPath = Excel.ActiveWorkbook.Path & "\" & Format(Date, "yyyy") & "\" & Format(Date, "mm") & "\" & Format(Date, "dd")
  6.    
  7.     Application.DisplayAlerts = False '關閉警告
  8.     bRun = True     '用以提前結束迴圈
  9.     nSeq = 0           '檔案序號
  10.     For i = 2 To 3
  11.         If bRun = False Then
  12.            Exit For
  13.         End If
  14.         For j = 2 To 4
  15.             If bRun = False Then
  16.                Exit For
  17.             End If
  18.             nSeq = nSeq + 1
  19.             sCheck = Excel.ActiveWorkbook.Path & "\" & Format(Date, "yyyy") & "\" & Format(Date, "mm") & "\" & Format(Date, "dd") & "\" & Filename & Format(nSeq, "0000") & ".csv"
  20.            ' MsgBox "[" & sCheck & "]", vbInformation '看檔名是否正確
  21.            If Dir(sCheck & "", vbDirectory) <> "" Then '檔案存在, 進行檢查
  22.                Cells(j, i).Formula = "=vlookup(A2,'" & strPath & "\[" & Filename & Format(nSeq, "0000") & ".csv]" & Filename & Format(nSeq, "0000") & "'!$A$2:$E$6,5,FALSE)"
  23.                Workbooks.Open Filename:=sCheck
  24.                 ActiveWindow.Close
  25.             Else                        '檔案不存在,收工
  26.                bRun = False
  27.             End If
  28.         Next j
  29.     Next i
  30.     Application.DisplayAlerts = True '開啟警告
  31. End Sub

複製代碼


tmh_ok.xlsm

19.33 KB, 下載次數: 0

售價: 1 金錢  [記錄]  [購買]

回復 支持 反對

使用道具 舉報

 樓主| 發表於 2017-4-27 10:15:16 | 顯示全部樓層
imingho 發表於 2017-4-27 09:17
程式碼有一段前後順序要改一下.我修改過了.您再執行看看.

老師
謝謝
可以執行了
我套用到原本的檔案試試看

剛剛看了老師FB
才發現 原來老師是我的老學長
回復 支持 反對

使用道具 舉報

發表於 2017-4-27 10:45:33 | 顯示全部樓層
z22344566 發表於 2017-4-27 10:15
老師
謝謝
可以執行了

是那一個學校的學長?
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2017-4-27 10:49:46 | 顯示全部樓層
imingho 發表於 2017-4-27 10:45
是那一個學校的學長?

聯合工專

只是我去讀的時候已經變聯合大學了
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2017-4-27 15:34:24 | 顯示全部樓層
老師好
是這樣子的
因為這是抓取機台每次產生的資料
之前抓xls檔是OK的
現在變成抓csv 所以多了開檔關檔的動作
機台每三分鐘會做出一筆數據
如果每次都這樣開檔關檔 怕最後excel會當掉
因為機台總共會產生出300筆資料
不知道是不是有辦法
判斷有值就不再抓取
序號不重頭 繼續抓下去
謝謝老師 麻煩指導了

vlookup_file.rar

25.69 KB, 下載次數: 7

回復 支持 反對

使用道具 舉報

發表於 2017-4-27 15:59:30 | 顯示全部樓層
z22344566 發表於 2017-4-27 15:34
老師好
是這樣子的
因為這是抓取機台每次產生的資料

您加入.text屬性等於#N/A再去開啟檔案.
  1. Private Sub CommandButton1_Click()

  2.        Dim strYear As String
  3.     Dim nSeq As String
  4.     Filename = Format(Date, "yymmdd")
  5.     strPath = Excel.ActiveWorkbook.Path & "\" & Format(Date, "yyyy") & "\" & Format(Date, "mm") & "\" & Format(Date, "dd")
  6.    
  7.     Application.DisplayAlerts = False '關閉警告
  8.     bRun = True     '用以提前結束迴圈
  9.     nSeq = 0           '檔案序號
  10.     For i = 2 To 21
  11.         If bRun = False Then
  12.            Exit For
  13.         End If
  14.         For j = 2 To 10
  15.             If bRun = False Then
  16.                Exit For
  17.             End If
  18.             nSeq = nSeq + 1
  19.             sCheck = Excel.ActiveWorkbook.Path & "\" & Format(Date, "yyyy") & "\" & Format(Date, "mm") & "\" & Format(Date, "dd") & "\" & Filename & Format(nSeq, "0000") & ".csv"
  20.            ' MsgBox "[" & sCheck & "]", vbInformation '看檔名是否正確
  21.            If Dir(sCheck & "", vbDirectory) <> "" Then '檔案存在, 進行檢查
  22.                Cells(j, i).Formula = "=vlookup(A2,'" & strPath & "\[" & Filename & Format(nSeq, "0000") & ".csv]" & Filename & Format(nSeq, "0000") & "'!$A$2:$E$6,5,FALSE)"
  23.                
  24.                If Cells(j, i).Text = "#N/A" Then
  25.                     Workbooks.Open Filename:=sCheck
  26.                     ActiveWindow.Close
  27.                End If
  28.             Else                        '檔案不存在,收工
  29.                bRun = False
  30.             End If
  31.         Next j
  32.     Next i
  33.     Application.DisplayAlerts = True '開啟警告
  34.    
  35.     Call Renew5


  36. End Sub


  37. Sub Renew5()

  38.     Application.OnTime Now + TimeValue("00:03:00"), "工作表5.SPC5"
  39.    
  40. End Sub


  41. Sub SPC5()

  42.      Dim strYear As String
  43.     Dim nSeq As String
  44.     Filename = Format(Date, "yymmdd")
  45.     strPath = Excel.ActiveWorkbook.Path & "\" & Format(Date, "yyyy") & "\" & Format(Date, "mm") & "\" & Format(Date, "dd")
  46.    
  47.     Application.DisplayAlerts = False '關閉警告
  48.     bRun = True     '用以提前結束迴圈
  49.     nSeq = 0           '檔案序號
  50.     For i = 2 To 21
  51.         If bRun = False Then
  52.            Exit For
  53.         End If
  54.         For j = 2 To 10
  55.             If bRun = False Then
  56.                Exit For
  57.             End If
  58.             nSeq = nSeq + 1
  59.             sCheck = Excel.ActiveWorkbook.Path & "\" & Format(Date, "yyyy") & "\" & Format(Date, "mm") & "\" & Format(Date, "dd") & "\" & Filename & Format(nSeq, "0000") & ".csv"
  60.            ' MsgBox "[" & sCheck & "]", vbInformation '看檔名是否正確
  61.            If Dir(sCheck & "", vbDirectory) <> "" Then '檔案存在, 進行檢查
  62.                Cells(j, i).Formula = "=vlookup(A2,'" & strPath & "\[" & Filename & Format(nSeq, "0000") & ".csv]" & Filename & Format(nSeq, "0000") & "'!$A$2:$E$6,5,FALSE)"
  63.                If Cells(j, i).Text = "#N/A" Then
  64.                     Workbooks.Open Filename:=sCheck
  65.                     ActiveWindow.Close
  66.                End If
  67.             Else                        '檔案不存在,收工
  68.                bRun = False
  69.             End If
  70.         Next j
  71.     Next i
  72.     Application.DisplayAlerts = True '開啟警告
  73.    
  74.     Call Renew5

  75. End Sub




複製代碼


OK.xlsm

30.06 KB, 下載次數: 1

售價: 1 金錢  [記錄]

回復 支持 反對

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  |网站地图

GMT+8, 2019-9-20 09:09 , Processed in 0.134173 second(s), 21 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表