返回列表 上一主題 發帖

[發問] Range'方法('_Global'物件)失敗

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-4-21 01:17 | 只看該作者

[發問] Range'方法('_Global'物件)失敗

小弟不才...之前發問了許多功能, 要結合成一個程式
結果出線如標題樣的錯誤

合併儲存格時就會出錯...., 說也奇怪...第一天撰寫完畢Try Run 都沒問題..第二天就出錯了


我先說明一下程式如何撰寫及邏輯

如下圖所示, 分為A檔案用來執行巨集,  B檔案為資料參考來源 ( 因為檔案名稱不一定, 但內容格式固定 )



執行程式方式:
1. 同時打開A, B 檔案 , 程式開始判斷B檔案的分頁3 , 相關欄位,判定沒有開錯B檔案(資料參考來源)
2. 將B檔案需要的欄位複製到A檔案內, 剪剪貼貼
3. 開始針對不需要保留的刪除
    3-1. 判斷I~T欄如果空白也刪除
4. 將Z欄位, 第一個『-』 前的資料刪除, 保留要的資料
5. 開始判斷B欄位、C欄位、D欄位、E欄位、F欄位、X欄位、Z欄位 只要相同就合併儲存格
    (下圖舉例圖) 出錯也在這


6. 之後就跑先前發問的問題   [發問] 如何將A欄相同的字, 插入新欄位新增到B欄裡
7. 調整欄寬
8. 調整列印設定

※ 程式執行完畢理想狀態如A檔案第三個分頁[ENG]  < 手動調整完成, 因出錯無法顯示那樣 >

Q1: 請問出錯的部分程式碼如何修正呢?
錯誤部分
  1. For Each xRR In xArea
  2.     If xRR & xRR(1, 2) <> xRR(0) & xRR(0, 2) Then Set xH = xRR
  3.     If xRR & xRR(1, 2) <> xRR(2) & xRR(2, 2) Then
  4.       Range(xH, xRR).Merge: Range(xH(1, 2), xRR(1, 2)).Merge    'MO
  5.       Range(xH, xRR).Merge: Range(xH(1, 3), xRR(1, 3)).Merge    'PC Code
  6.       Range(xH, xRR).Merge: Range(xH(1, 4), xRR(1, 4)).Merge    'Device
  7.       Range(xH, xRR).Merge: Range(xH(1, 5), xRR(1, 5)).Merge    'Date
  8.       Range(xH, xRR).Merge: Range(xH(1, 24), xRR(1, 24)).Merge  'MO QTY
  9.       Range(xH, xRR).Merge: Range(xH(1, 26), xRR(1, 26)).Merge  ' BD NO
  10.       Range(xH, xRR(1, 26)).Borders.LineStyle = 1
  11.       For i = 7 To 10
  12.           Range(xH, xRR(1, 26)).Borders(i).Weight = xlMedium
  13.       Next i
  14.     End If
  15. Next
複製代碼
Q2: 目前因為小弟太笨, 所以三個按鈕都是個別跑各自分頁, 有辦法跑一次程式, 自動分去三個分頁嗎?
A檔案的三個分頁, 都是參考B檔案分頁3的資料
差異於
A檔案分頁2 是要將如下條件都刪除
  1.      For g = .Range("A65536").End(xlUp).Row To 2 Step -1
  2.         If .Cells(g, "A") Like "BGA*" Or _
  3.            .Cells(g, "C") Like "*CSP-L1*" Or _
  4.            .Cells(g, "C") Like "*L1*" Or _
  5.            .Cells(g, "C") Like "*L2*" Or _
  6.            .Cells(g, "C") Like "*CSP*" Or _
  7.            .Cells(g, "C") Like "*ENG*" Or _
  8.            .Cells(g, "C") Like "*HQ-CSP*" Or _
  9.            .Cells(g, "C") Like "*HQ-L2*" Then
  10.             .Rows(g).Delete
  11.         End If
  12.      Next
複製代碼
A檔案分頁3 是只要保留如下條件, 期他都刪除
  1.      For g = .Range("A65536").End(xlUp).Row To 2 Step -1
  2.            If Not .Cells(g, "C") Like "*ENG*" Then
  3.             .Rows(g).Delete
  4.         End If
  5.      Next
複製代碼
A檔案分頁4 是只要保留如下條件, 期他都刪除
  1.     For y = .Range("A65536").End(xlUp).Row To 2 Step -1
  2.         If Not .Cells(y, "C") Like "*CSP-L1*" And _
  3.            Not .Cells(y, "C") Like "*L1*" And _
  4.            Not .Cells(y, "C") Like "*L2*" And _
  5.            Not .Cells(y, "C") Like "*CSP*" And _
  6.            Not .Cells(y, "C") Like "*HQ-CSP*" And _
  7.            Not .Cells(y, "C") Like "*HQ-L2*" Then
  8.             .Rows(y).Delete
  9.         End If
  10.      Next
  11. End With
複製代碼
test.rar (656.48 KB)
收藏 分享

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
2#
發表於 2016-4-21 05:36 | 只看該作者
回復 1# v03586
發生錯誤時按下偵錯,
即時運算視窗打上
?Xh.Address
與
?xRR.Address
看看儲存格位址是否正確.

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
3#
發表於 2016-4-21 07:31 | 只看該作者
回復 1# v03586
你中途宣告了 Dim xH As Range 後，
一直到 For Each xRR In xArea 之間
並未給予  xH 物件任何值 (Nothing)，
接著你又急急忙忙地來個 "霸王硬上弓"，
Range(xH, xRR).Merge
不出錯才怪！
  1. 執行階段錯誤 '1004':
  2. 'Range'方法 ('_Global'物件)失敗
複製代碼

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-23 
4#
發表於 2016-4-21 10:43 | 只看該作者
本帖最後由 准提部林 於 2016-4-21 10:45 編輯

Set xArea = Sheets("FMC").Range("A3:A" & R)
改為：
Set xArea = Sheets("FMC").Range("A2:A" & R)

資料從第２列開始∼∼
RR = [FMC!A65536].End(xlUp).Row: If RR < 3 Then Exit Sub
RR = [FMC!A65536].End(xlUp).Row: If RR < 2 Then Exit Sub

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
5#
發表於 2016-4-21 12:31 | 只看該作者
回復 4# 准提部林


    改完後第一欄抬頭欄位 會被合併且有資料, 感覺是被合併了
如下圖


今天早上嘗試, 未修改程式碼前, 如下另外一份B檔案( 格式都沒變 )  , 竟然HQ可以跑得出來, 但其他ENG , 傳統無法執行, 真的不知道發生什麼事
B-1.rar (738.45 KB)

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-23 
6#
發表於 2016-4-21 12:51 | 只看該作者
回復 5# v03586

我的版本無法測完整程式,
可先將Call test註解掉不執行, 再去找問題出在哪個環節,
照說應跑完資料後, 再處理標題列上方的兩列!
版本太舊,幫不了忙!!

TOP

v03586

帖子
193 
主題
29 
精華
0 
積分
222 
點名
0  
作業系統
Windows7 
軟體版本
OFFICE2013 
閱讀權限
20 
註冊時間
2015-9-18 
最後登錄
2023-4-29 
7#
發表於 2016-4-22 07:42 | 只看該作者
回復 6# 准提部林


    感謝大大的support @@ 我版本是使用2003 撰寫 !!

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
8#
發表於 2016-4-22 08:47 | 只看該作者
本帖最後由 c_c_lai 於 2016-4-22 09:18 編輯

回復 5# v03586
回復 4# 准提部林
正如准提部林大大所言，經實際測試後，它是關鍵所在。
Module1:  Sub 新報表_HQ匯入()
  1. Dim RR&, xArea As Range, xRR As Range, xH As Range, T, TT, XX
  2. RR = [FMC!A65536].End(xlUp).Row: If RR < 3 Then Exit Sub
  3. '  請將 ("A3:A" & R) 修改成 ("A2:A" & R) 即可。
  4. '  Set xArea = Sheets("FMC").Range("A3:A" & R)
  5. Set xArea = Sheets("FMC").Range("A2:A" & R)

  7. For Each xRR In xArea
  8.     T = xRR(1, 26): xRR(1, 26) = Mid(T, InStr(T, "-") + 1)
  9. Next
複製代碼
'  xRR & xRR(1, 2)    : "eMCP SIP162L 11.5*132981180" : Variant/String
    '  xRR(0) & xRR(0, 2) : "eMCP SIP162L 11.5*132981180" : Variant/String
    '  xH                 : Nothing                       : Range
    '  xRR(2) & xRR(2, 2) : "eMCP SIP162L 11.5*132981181" : Variant/String
    '  
    '  執行階段錯誤 '1004':
    '  Range'方法 ('_Global'物件)失敗
    '  
    '  PKG        MONBR        PCCode        DEVICE        IPT_DATE        DavinciCode
    '  eMCP SIP162L 11.5*13        2981180        KSI-PS-A0419-16        P-PS0703MKP82110EG-NR4GCA2-CTHD08GD1-45        2016/4/20 01:01        R1F60:02
    '  eMCP SIP162L 11.5*13        2981180        KSI-PS-A0419-16        P-PS0703MKP82110EG-NR4GCA2-CTHD08GD1-45        2016/4/20 01:01        B1D25:03
    '  eMCP SIP162L 11.5*13        2981181        KSI-PS-A0419-16        P-PS0703MKP82110EG-NR4GCA2-CTHD08GD1-45        2016/4/20 01:01        R1F60:02

    '  ----------------------------------------------------------------------
    '  B-1.xlsx
    '  xRR & xRR(1, 2)    : "eMCP SIP162L 11.5*132981181" : Variant/String
    '  xRR(0) & xRR(0, 2) : "eMCP SIP162L 11.5*132981180" : Variant/String
    '  xH                 : "eMCP SIP162L 11.5*13"        : Range
    '  xRR(2) & xRR(2, 2) : "eMCP SIP162L 11.5*132981182" : Variant/String
    '   
    '  xRR & xRR(1, 2)    : "eMCP SIP162L 11.5*132981182" : Variant/String
    '  xRR(0) & xRR(0, 2) : "eMCP SIP162L 11.5*132981181" : Variant/String
    '  xH                 : "eMCP SIP162L 11.5*13"        : Range
    '  xRR(2) & xRR(2, 2) : "eMCP SIP162L 11.5*132981182" : Variant/String

    '  PKG        MONBR        PCCode        DEVICE        IPT_DATE        DavinciCode
    '  eMCP SIP162L 11.5*13        2981180        KSI-PS-A0419-16        P-PS0703MKP82110EG-NR4GCA2-CTHD08GD1-45        2016/4/20 01:01        R1F60:02
    '  eMCP SIP162L 11.5*13        2981181        KSI-PS-A0419-16        P-PS0703MKP82110EG-NR4GCA2-CTHD08GD1-45        2016/4/20 01:01        R1F60:02
    '  eMCP SIP162L 11.5*13        2981182        KSI-PS-A0419-16        P-PS0703MKP82110EG-NR4GCA2-CTHD08GD1-45        2016/4/20 01:01        R1F60:02
問題導源於:
  1. Set xArea = Sheets("FMC").Range("A3:A" & R)
複製代碼

TOP

        靜思自在 : 人生不一定球球是好球，但是有歷練的強打者，隨時都可以揮棒。
返回列表 上一主題