麻辣家族討論版版 » Excel程式區 » 同樣巨集另一檔案卻執行錯誤

返回列表下一主題上一主題發帖

同樣巨集另一檔案卻執行錯誤

小學生 Rank: 1

帖子: 9
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: win xp
軟體版本: Office 2003
閱讀權限: 10
性別: 男
來自: 台中
註冊時間: 2010-8-5
最後登錄: 2010-8-12

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2010-8-5 13:09 | 只看該作者

同樣巨集另一檔案卻執行錯誤

本帖最後由 ycchenzd 於 2010-8-5 22:02 編輯

小弟之前在舊論壇發問的一個問題
http://gb.twbts.com/index.php?topic=12801.0

sheet1內容不固定,但會依此排序
sheet2內容固定,比對sheet1後,將符合的列複製於sheet3
sheet3為結果

使用下列程式碼
Sub nn()
Dim Rng As Range, A As Range, Cell As Range
With Sheet2
Set Rng = .Range(.[A1], .[A65536].End(xlUp))
End With
With Sheet1
For Each A In .Range(.[D1], .[D65536].End(xlUp))
　　If Not Rng.Find(A, lookat:=xlWhole) Is Nothing Then
　　　 If Cell Is Nothing Then Set Cell = A Else Set Cell = Union(Cell, A)
　　End If
Next
End With
Sheet3.Cells = ""
Cell.EntireRow.Copy Sheet3.[A1]　　　
End Sub

但是在原本檔案執行ok,
要在另一個以資料庫抓取後的資料檔執行時卻會在Cell.EntireRow.Copy Sheet3.[A1]　出現錯誤
類似Class copy 的方法錯誤,
但是執行後的資料是正確的
不知問題出在哪裡,資料內容是一樣的啊
懇請解答

會是跟欄位格式有關嗎?

已補上檔案

book1.zip (52.51 KB)

收藏

小學生 Rank: 1

帖子: 9
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: win xp
軟體版本: Office 2003
閱讀權限: 10
性別: 男
來自: 台中
註冊時間: 2010-8-5
最後登錄: 2010-8-12

13^#

發表於 2010-8-12 23:18 | 只看該作者

測試結果只有以下方式OK
cell.EntireRow.Copy
Sheet8.Range("A1").PasteSpecial Paste:=xlPasteValues

不過,總之是有成功了
還是謝謝大家了

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

12^#

發表於 2010-8-6 12:20 | 只看該作者

測試OK,無錯誤了
但是同樣電腦,另一個檔案以原程式也是OK,差別只在資料來源不一樣
不知何因? 不 ...
ycchenzd 發表於 2010-8-6 12:15

問題可能是這裡

小學生 Rank: 1

帖子: 9
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: win xp
軟體版本: Office 2003
閱讀權限: 10
性別: 男
來自: 台中
註冊時間: 2010-8-5
最後登錄: 2010-8-12

11^#

發表於 2010-8-6 12:18 | 只看該作者

回復 5# kimbal

謝謝,改天會試試

小學生 Rank: 1

帖子: 9
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: win xp
軟體版本: Office 2003
閱讀權限: 10
性別: 男
來自: 台中
註冊時間: 2010-8-5
最後登錄: 2010-8-12

10^#

發表於 2010-8-6 12:17 | 只看該作者

回復 8# GBKEE

改天再來試試這個
檔案在公司電腦
謝謝了

小學生 Rank: 1

帖子: 9
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: win xp
軟體版本: Office 2003
閱讀權限: 10
性別: 男
來自: 台中
註冊時間: 2010-8-5
最後登錄: 2010-8-12

9^#

發表於 2010-8-6 12:15 | 只看該作者

回復 ycchenzd

版本問題,07上運是沒問題的, 03的會出問題

請試試把換成
kimbal 發表於 2010-8-6 01:07

測試OK,無錯誤了
但是同樣電腦,另一個檔案以原程式也是OK,差別只在資料來源不一樣
不知何因?

不過還是OK了
謝謝了

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2010-8-6 07:44 | 只看該作者

以你上傳的檔案測試並未產生錯誤
加個判斷式試試看If Not Cell Is Nothing Then Cell.EntireRow.Copy Sh ... 可能你Rng.Find(A, lookat:=xlWhole) 一直是找不到吻合的儲存格
Hsieh 發表於 2010-8-5 23:04

試試看修改成 Rng.Find(A, LookIn:=xlValues, lookat:=xlWhole)

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 472
主題: 5
精華: 0
積分: 485
點名: 0
作業系統: Windows
軟體版本: MS Office
閱讀權限: 100
性別: 男
來自: 香港
註冊時間: 2010-7-4
最後登錄: 2014-12-28

論壇貢獻勳章

7^#

發表於 2010-8-6 01:07 | 只看該作者

本帖最後由 kimbal 於 2010-8-6 01:10 編輯

回復 6# ycchenzd

版本問題,07上運是沒問題的, 03的會出問題

請試試把

Cell.EntireRow.Copy Sheet3.[A1]

複製代碼

換成

cell.EntireRow.Copy
Sheet3.Range("A1").PasteSpecial Paste:=xlPasteValues

複製代碼

懂得發問,答案就會在其中

今日の一秒は明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

小學生 Rank: 1

帖子: 9
主題: 2
精華: 0
積分: 11
點名: 0
作業系統: win xp
軟體版本: Office 2003
閱讀權限: 10
性別: 男
來自: 台中
註冊時間: 2010-8-5
最後登錄: 2010-8-12

6^#

發表於 2010-8-6 00:40 | 只看該作者

以你上傳的檔案測試並未產生錯誤
加個判斷式試試看
If Not Cell Is Nothing Then Cell.EntireRow.Copy Sh ...
Hsieh 發表於 2010-8-5 23:04

加了If Not Cell Is Nothing Then Cell.EntireRow.Copy Sheet8.[A1]
還是一樣錯誤耶

在您那執行正確嗎?

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 472
主題: 5
精華: 0
積分: 485
點名: 0
作業系統: Windows
軟體版本: MS Office
閱讀權限: 100
性別: 男
來自: 香港
註冊時間: 2010-7-4
最後登錄: 2014-12-28

論壇貢獻勳章

5^#

發表於 2010-8-6 00:15 | 只看該作者

試試這個:

Option Explicit
Sub nn()
Dim Rng As Range, A As Range, cell As Range
With Sheet6
Set Rng = .Range(.[A1], .[A65536].End(xlUp))
End With
With Sheet7
For Each A In .Range(.[D1], .[D65536].End(xlUp))
If Not Rng.Find(A, lookat:=xlWhole) Is Nothing Then
If cell Is Nothing Then Set cell = A Else Set cell = Union(cell, A)
End If
Next
End With
Sheet8.Cells.Clear
cell.EntireRow.Copy
Sheet8.Range("A1").PasteSpecial Paste:=xlPasteValues
End Sub

複製代碼

給其他大大參考:

懂得發問,答案就會在其中

今日の一秒は明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

靜思自在 : 口說一句好話，如口出蓮花；口說一句壞話如口吐毒蛇。

返回列表下一主題上一主題