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

v03586

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

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

下載 (23.95 KB)

2016-4-21 00:55

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

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

下載 (69.63 KB)

2016-4-21 00:54

執行程式方式:
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.3 KB)

2016-4-21 01:07

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)

下載次數: 4

2016-4-21 01:17

c_c_lai

回復 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)
   
6. 
   
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)

複製代碼

v03586

回復 6# 准提部林


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

准提部林

回復 5# v03586

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

v03586

回復 4# 准提部林


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

下載 (20.37 KB)

2016-4-21 12:25

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

下載次數: 5

2016-4-21 12:27

准提部林

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

c_c_lai

回復 1# v03586
你中途宣告了 Dim xH As Range 後，
一直到 For Each xRR In xArea 之間
並未給予  xH 物件任何值 (Nothing)，
接著你又急急忙忙地來個 "霸王硬上弓"，
Range(xH, xRR).Merge
不出錯才怪！

1. 執行階段錯誤 '1004':
   
2. 'Range'方法 ('_Global'物件)失敗

複製代碼

luhpro

回復 1# v03586
發生錯誤時按下偵錯,
即時運算視窗打上
?Xh.Address
與
?xRR.Address
看看儲存格位址是否正確.