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

標題: [發問] Range'方法('_Global'物件)失敗 [打印本頁]

作者: v03586 時間: 2016-4-21 01:17 標題: Range'方法('_Global'物件)失敗

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

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

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

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

[attach]23916[/attach]

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

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

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

Q1: 請問出錯的部分程式碼如何修正呢?
錯誤部分

For Each xRR In xArea
If xRR & xRR(1, 2) <> xRR(0) & xRR(0, 2) Then Set xH = xRR
If xRR & xRR(1, 2) <> xRR(2) & xRR(2, 2) Then
Range(xH, xRR).Merge: Range(xH(1, 2), xRR(1, 2)).Merge 'MO
Range(xH, xRR).Merge: Range(xH(1, 3), xRR(1, 3)).Merge 'PC Code
Range(xH, xRR).Merge: Range(xH(1, 4), xRR(1, 4)).Merge 'Device
Range(xH, xRR).Merge: Range(xH(1, 5), xRR(1, 5)).Merge 'Date
Range(xH, xRR).Merge: Range(xH(1, 24), xRR(1, 24)).Merge 'MO QTY
Range(xH, xRR).Merge: Range(xH(1, 26), xRR(1, 26)).Merge ' BD NO
Range(xH, xRR(1, 26)).Borders.LineStyle = 1
For i = 7 To 10
Range(xH, xRR(1, 26)).Borders(i).Weight = xlMedium
Next i
End If
Next

複製代碼

Q2: 目前因為小弟太笨, 所以三個按鈕都是個別跑各自分頁, 有辦法跑一次程式, 自動分去三個分頁嗎?
A檔案的三個分頁, 都是參考B檔案分頁3的資料
差異於
A檔案分頁2 是要將如下條件都刪除

For g = .Range("A65536").End(xlUp).Row To 2 Step -1
If .Cells(g, "A") Like "BGA*" Or _
.Cells(g, "C") Like "*CSP-L1*" Or _
.Cells(g, "C") Like "*L1*" Or _
.Cells(g, "C") Like "*L2*" Or _
.Cells(g, "C") Like "*CSP*" Or _
.Cells(g, "C") Like "*ENG*" Or _
.Cells(g, "C") Like "*HQ-CSP*" Or _
.Cells(g, "C") Like "*HQ-L2*" Then
.Rows(g).Delete
End If
Next

複製代碼

A檔案分頁3 是只要保留如下條件, 期他都刪除

For g = .Range("A65536").End(xlUp).Row To 2 Step -1
If Not .Cells(g, "C") Like "*ENG*" Then
.Rows(g).Delete
End If
Next

複製代碼

A檔案分頁4 是只要保留如下條件, 期他都刪除

For y = .Range("A65536").End(xlUp).Row To 2 Step -1
If Not .Cells(y, "C") Like "*CSP-L1*" And _
Not .Cells(y, "C") Like "*L1*" And _
Not .Cells(y, "C") Like "*L2*" And _
Not .Cells(y, "C") Like "*CSP*" And _
Not .Cells(y, "C") Like "*HQ-CSP*" And _
Not .Cells(y, "C") Like "*HQ-L2*" Then
.Rows(y).Delete
End If
Next
End With

複製代碼

[attach]23919[/attach]

作者: luhpro 時間: 2016-4-21 05:36

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

作者: c_c_lai 時間: 2016-4-21 07:31

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

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

複製代碼

作者: 准提部林 時間: 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

作者: v03586 時間: 2016-4-21 12:31

回復 4# 准提部林

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

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

作者: 准提部林 時間: 2016-4-21 12:51

回復 5# v03586

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

作者: v03586 時間: 2016-4-22 07:42

回復 6# 准提部林

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

作者: c_c_lai 時間: 2016-4-22 08:47

本帖最後由 c_c_lai 於 2016-4-22 09:18 編輯

回復 5# v03586
回復 4# 准提部林
正如准提部林大大所言，經實際測試後，它是關鍵所在。
Module1: Sub 新報表_HQ匯入()

Dim RR&, xArea As Range, xRR As Range, xH As Range, T, TT, XX
RR = [FMC!A65536].End(xlUp).Row: If RR < 3 Then Exit Sub
' 請將 ("A3:A" & R) 修改成 ("A2:A" & R) 即可。
' Set xArea = Sheets("FMC").Range("A3:A" & R)
Set xArea = Sheets("FMC").Range("A2:A" & R)
For Each xRR In xArea
T = xRR(1, 26): xRR(1, 26) = Mid(T, InStr(T, "-") + 1)
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
問題導源於:

Set xArea = Sheets("FMC").Range("A3:A" & R)

複製代碼

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)