123
返回列表 上一主題 發帖

[發問] 如何匯入EXCEL資料?

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
11# 跳轉到 »
發表於 2012-5-17 10:40 | 顯示全部帖子
回復 10# Hsieh
版大,
我測試了您的程式,發生以下問題,所以無法執行 ,請您撥冗看下. 謝謝
1)  程式指向這行  d(Sh.Name & "數量") = b.Offset(, -1) 然後出現對話框  
2)  之後出現其中一個excel檔   BCM120105-10 CF blank cap-PO#3310 (出加拿大).zip (23.71 KB)

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
12#
發表於 2012-5-17 16:31 | 顯示全部帖子
回復 21# Hsieh
版大,
這個程式出現一個對話框 with.jpg
我試著去改End With的位置,但還是無法執行,請再幫忙看看!

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
13#
發表於 2012-5-17 16:40 | 顯示全部帖子
回復 19# PJChen
老大,
補充: 我試著自己key完整的檔名在F欄,然後將2012年的bcm檔案放在"2012 PI_PO"資料夾中(因為年度很多,怕run太久),然後修改程式如下,但完全不能動作!
  1. Sub get_value()
  2.     Dim a As Range, arr(1 To 5)
  3.     Application.ScreenUpdating = False    '關閉螢幕閃爍
  4.     For Each a In Range([f2], [f2].End(4))    '在f2以下的資料範圍循環
  5.         If Application.CountA(Rows(a.Row)) = 1 Then    'a:e欄已有寫入資料就跳過
  6.             Application.DisplayAlerts = False    '關閉開啟時的對話方塊
  7.             fb = ThisWorkbook.Path & "\2012 PI_PO\" & a    '從"PI_PO資料夾"取路徑
  8.             Set wk = GetObject(fb)    '背景開啟該路徑檔案
  9.             Sh = Array("PI", "PO")    '兩個工作表名
  10.             On Error Resume Next    '略過錯誤
  11.             For s = 0 To 1
  12.                 Set mysheet = wk.Sheets(Sh(s))    '工作表變量
  13.                 If Err.Number = 0 Then    '如不發生錯誤(有這個工作表)
  14.                 mysheet.AutoFilterMode = False '取消篩選
  15.                     mysheet.[a:b].Replace "TOTAL:", "TOTAL", xlWhole    '把帶分號的TOTAL改成不帶分號
  16.                     r = mysheet.[a:b].Find("TOTAL", , , 1, xlByRows).Row            '在AB兩欄尋找"TOTAL"
  17.                     c = mysheet.Cells(r, 15).End(1).Column    '取TOTAL那一行的最右欄(即金額)
  18.                     arr(1) = Split(a, " ")(0) '取f欄第一個空格以前的字串
  19.                     arr(s * 2 + 2) = mysheet.Cells(r, c - 3).Value    '取最右欄減3欄的數字
  20.                     arr(s * 2 + 3) = mysheet.Cells(r, c).Value    '取最右欄的數字
  21.                 End If
  22.                 Err.Clear    '清除錯誤
  23.             Next
  24.            Cells(a.Row, 1).Resize(1, 5) = arr   '寫入儲存格
  25.             Erase arr
  26.             wk.Close 0            '關閉打開的檔案不儲存
  27.         End If
  28.     Next
  29. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
14#
發表於 2012-5-17 21:05 | 顯示全部帖子
回復 24# Hsieh
VBA TEST 5-answer 4_Hsieh.zip (213.25 KB)
Dear 大人,

我將您修正的程式Run過後,有以下問題,
1)  我將原檔名各key-in在a及f欄,因為前面oobird提過完整的檔名比較容易抓資料,所以我就這麼作.
2)  Run完程式後,它只把A欄的完整檔名修改為我原先最初的BCM no.,其餘欄位完全未填入數值.
3)  我將Run完的結果上傳了,要麻煩您幫我看一下,我不知道發生了什麼事?
謝謝您!

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
15#
發表於 2012-5-17 22:16 | 顯示全部帖子
回復 26# Hsieh
老大,

VBA TEST 5-answer 4.zip (351.94 KB)
PI_PO Records黃色底的部份無法填入數值,我猜想可能是格式不相同的問題?因為每個人的工作表格式都不同,有得救嗎?

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
16#
發表於 2012-5-18 10:11 | 顯示全部帖子
回復 18# oobird
老大,不好意思這是回覆給你的,我按錯樓層,我想你應該沒收到,我將前2次做個整理.
1) 我先試了抓取F欄file name的巨集,發現它只會將所有檔名抓進來而不會比對.
2) 我試著自己key完整的檔名在F欄,然後將2012年的bcm檔案放在"2012 PI_PO"資料夾中(因為年度很多,怕run太久),然後修改程式如下,但完全不能動作!
  1. Sub get_value()
  2.     Dim a As Range, arr(1 To 5)
  3.     Application.ScreenUpdating = False    '關閉螢幕閃爍
  4.     For Each a In Range([f2], [f2].End(4))    '在f2以下的資料範圍循環
  5.         If Application.CountA(Rows(a.Row)) = 1 Then    'a:e欄已有寫入資料就跳過
  6.             Application.DisplayAlerts = False    '關閉開啟時的對話方塊
  7.             fb = ThisWorkbook.Path & "\2012 PI_PO\" & a    '從"PI_PO資料夾"取路徑
  8.             Set wk = GetObject(fb)    '背景開啟該路徑檔案
  9.             Sh = Array("PI", "PO")    '兩個工作表名
  10.             On Error Resume Next    '略過錯誤
  11.             For s = 0 To 1
  12.                 Set mysheet = wk.Sheets(Sh(s))    '工作表變量
  13.                 If Err.Number = 0 Then    '如不發生錯誤(有這個工作表)
  14.                 mysheet.AutoFilterMode = False '取消篩選
  15.                     mysheet.[a:b].Replace "TOTAL:", "TOTAL", xlWhole    '把帶分號的TOTAL改成不帶分號
  16.                     r = mysheet.[a:b].Find("TOTAL", , , 1, xlByRows).Row            '在AB兩欄尋找"TOTAL"
  17.                     c = mysheet.Cells(r, 15).End(1).Column    '取TOTAL那一行的最右欄(即金額)
  18.                     arr(1) = Split(a, " ")(0) '取f欄第一個空格以前的字串
  19.                     arr(s * 2 + 2) = mysheet.Cells(r, c - 3).Value    '取最右欄減3欄的數字
  20.                     arr(s * 2 + 3) = mysheet.Cells(r, c).Value    '取最右欄的數字
  21.                 End If
  22.                 Err.Clear    '清除錯誤
  23.             Next
  24.            Cells(a.Row, 1).Resize(1, 5) = arr   '寫入儲存格
  25.             Erase arr
  26.             wk.Close 0            '關閉打開的檔案不儲存
  27.         End If
  28.     Next
  29. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
17#
發表於 2012-5-18 10:37 | 顯示全部帖子
回復 28# Hsieh
版大,
改成這樣目前無法執行, 出現了這樣的訊息: 引數不正確.jpg

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
18#
發表於 2012-5-18 12:05 | 顯示全部帖子
回復 31# oobird

老大,
我重新RUN一次,有三個檔案會出錯,我上傳了.再麻煩您!
VBA TEST 5-answer 5.zip (120.16 KB)

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
19#
發表於 2012-5-18 12:54 | 顯示全部帖子
回復 28# Hsieh
大人,
以下的程式執行時,若發現資料有連結,會一直出現對話框,可以讓它自選擇不更新而繼續執行嗎?
  1. Sub get_value()
  2. Dim Sh As Worksheet, a As Range, Ar(), B As Range, B1 As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Application.ScreenUpdating = False
  5. Application.DisplayAlerts = False
  6. fd = ThisWorkbook.Path & "\" & "2011 PI_PO\"
  7. fs = Dir(fd & "*xls*")
  8. Do Until fs = ""
  9. With Workbooks.Open(fd & fs)
  10. n = Split(fs, " ")(0)
  11. s = InStr(n, "BCM") + 3
  12. fn = Mid(n, s)
  13.    For Each Sh In .Sheets
  14.       With Sh
  15.       If Trim(.Name) <> "PO" And Trim(.Name) <> "PI" Then GoTo 10
  16.       For Each c In .Range("A:B").SpecialCells(xlCellTypeConstants)
  17.         If c Like "TOTAL*" Then Set a = c: Exit For
  18.       Next
  19.       If Not a Is Nothing Then
  20.       Set B = a.EntireRow.Find("pcs")
  21.       Set B1 = a.EntireRow.Find("*", after:=B)
  22.       
  23.       If Not B Is Nothing Then
  24.         d(Trim(.Name) & "數量") = B.Offset(, -1)
  25.         c1 = a.EntireRow.Find("*", after:=B1)
  26.         d(Trim(.Name) & "金額") = c1
  27.       End If
  28.       End If
  29.       Set a = Nothing
  30.       End With
  31. 10
  32.     Next
  33.     ReDim Preserve Ar(y)
  34.     Ar(y) = Array(fn, d("PI數量"), d("PI金額"), d("PO數量"), d("PO金額"), fs)
  35.     y = y + 1
  36.     .Close
  37.     d.RemoveAll
  38. End With
  39. fs = Dir
  40. Loop
  41. Sheets("Records").[A2].Resize(y, 6) = Application.Transpose(Application.Transpose(Ar))
  42. Application.ScreenUpdating = True
  43. Application.DisplayAlerts = True
  44. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
20#
發表於 2012-5-18 14:11 | 顯示全部帖子
回復 33# oobird
老大,
我將去年的PI/PO拿來測試,發現還是會一直出現對話框,詢問是否更新連結, 雖然程式中有這句話 Application.DisplayAlerts = False
  1. Sub get_value_F()
  2.     Dim a As Range, arr(1 To 5)
  3.     Application.ScreenUpdating = False    '關閉螢幕閃爍
  4.     For Each a In Range([f2], [f2].End(4))    '在f2以下的資料範圍循環
  5.         If Application.CountA(Rows(a.Row)) = 1 Then    'a:e欄已有寫入資料就跳過
  6.             Application.DisplayAlerts = False    '關閉開啟時的對話方塊
  7.             fb = ThisWorkbook.Path & "\2011 PI_PO\" & a    '從"PI_PO資料夾"取路徑
  8.             Set wk = GetObject(fb)    '背景開啟該路徑檔案
  9.             Sh = Array("PI", "PO")    '兩個工作表名
  10.             On Error Resume Next    '略過錯誤
  11.             For s = 0 To 1
  12.                 Set mysheet = wk.Sheets(Sh(s))    '工作表變量
  13.                 If Err.Number = 0 Then    '如不發生錯誤(有這個工作表)
  14.                 mysheet.AutoFilterMode = False '取消篩選
  15.                     mysheet.[a:b].Replace "TOTAL:", "TOTAL", xlWhole    '把帶分號的TOTAL改成不帶分號
  16.                     r = mysheet.[a:b].Find("TOTAL", , , 1, xlByRows).Row    '在AB兩欄尋找"TOTAL"
  17.                     c = mysheet.Cells(r, 15).End(1).Column    '取TOTAL那一行的最右欄(即金額)
  18.                     arr(1) = Split(a, " ")(0) '取f欄第一個空格以前的字串
  19.                     arr(s * 2 + 2) = mysheet.Cells(r, c - 3).Value    '取最右欄減3欄的數字
  20.                     arr(s * 2 + 3) = mysheet.Cells(r, c).Value    '取最右欄的數字
  21.                 End If
  22.                 Err.Clear    '清除錯誤
  23.             Next
  24.            Cells(a.Row, 1).Resize(1, 5) = arr   '寫入儲存格
  25.             Erase arr
  26.             wk.Close 0            '關閉打開的檔案不儲存
  27.         End If
  28.     Next
  29. End Sub
複製代碼

TOP

        靜思自在 : 口說好話、心想好意、身行好事。
123
返回列表 上一主題