想請教,從多個活頁簿找到關鍵字後複製下一列,但一直有錯誤
- 帖子
- 8
- 主題
- 2
- 精華
- 0
- 積分
- 10
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2007
- 閱讀權限
- 10
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2014-12-12
- 最後登錄
- 2016-4-13
|
想請教,從多個活頁簿找到關鍵字後複製下一列,但一直有錯誤
想請教,從多個活頁簿找到關鍵字後複製下一列,但一直有錯誤
Sub ex()
Dim Ar(), i%, C$, A As Range
With Sheets(1) '第一張工作表
C = "身分證或統一證號" '要篩選的值
For i = 2 To Sheets.Count '從第2張工作表開始回圈
With Sheets(i)
For Each A In .UsedRange.Columns(1).Cells 'A欄已使用儲存格做迴圈
If A = C Then '如果與要篩選的值相同
ReDim Preserve Ar(s)
Ar(s) = A.Offset(1).Resize(, 11) '將該列A:k欄寫入陣列
s = s + 1
End If
Next
End With
Next
.[A4].CurrentRegion.Offset(1).ClearContents '清除舊有資料
If s > 0 Then .[A5].Resize(s, 11) = Application.Transpose(Application.Transpose(Ar)) '若有符合項目則寫入工作表1的A5以下位置
End With
End Sub
在這一行一直出現錯誤"13"型態不符合,我不知是否我的活頁簿太多,其實活頁簿共有約500頁,如果我1~60頁保留,其後都刪掉,就沒有錯誤
If s > 0 Then .[A5].Resize(s, 11) = Application.Transpose(Application.Transpose(Ar)) '若有符合項目則寫入工作表1的A5以下位置
不知可否幫忙解決,如果能有抓同一資料夾內的.xlsx檔案方法就可好了,我就不用將檔案的活頁簿塞到同一個.xlsx檔裡,我的每個檔只有一個活頁簿
 201407-12_error.zip (929.88 KB)
|
|
|
努力學習
|
|
|
|
|
- 帖子
- 8
- 主題
- 2
- 精華
- 0
- 積分
- 10
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2007
- 閱讀權限
- 10
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2014-12-12
- 最後登錄
- 2016-4-13
|
5#
發表於 2014-12-26 13:34
| 只看該作者
感謝 版主GBKEE 的驗証程式,替我解決問題
感謝 bobomi 的熱心回覆,謝謝 |
|
|
努力學習
|
|
|
|
|
- 帖子
- 181
- 主題
- 5
- 精華
- 0
- 積分
- 197
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- 2000
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2014-3-9
- 最後登錄
- 2024-4-29
|
4#
發表於 2014-12-26 11:29
| 只看該作者
經測試 Application.Transpose
可能是 bug 或 有限制陣列數量
以下範例
ReDim a(1 To 11, 0 To ...
bobomi 發表於 2014-12-26 07:45 
這個問題
Excel 2000 --> 會出現錯誤訊息
Excel 2014 --> 不會出現錯誤訊息 |
|
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
3#
發表於 2014-12-26 11:10
| 只看該作者
本帖最後由 GBKEE 於 2014-12-26 15:06 編輯
回復 1# hasrhgni
Application.Transpose ,陣列的元素字元數大於255 個字元,會有錯誤- Option Explicit
- Sub Ex()
- Dim Ar(), i%, C$, A As Range, XX As Integer, Msg As Boolean
- Dim S As Integer
- With Sheets(1) '第一張工作表
- C = "身分證或統一證號" '要篩選的值
- For i = 2 To Sheets.Count '從第2張工作表開始回圈
- With Sheets(i)
- For Each A In .UsedRange.Columns(1).Cells 'A欄已使用儲存格做迴圈
- If A = C Then '如果與要篩選的值相同
- ReDim Preserve Ar(S)
- '**** 除錯程式 找出欄寬限制在 255 個字元以外的儲存格 ********
- Msg = False
- For XX = 1 To 11
- ' 欄寬限制在 255 個字元以內
- If Len(A(2, XX)) > 255 Then
- Sheets(i).Activate
- A.Select
- Debug.Print Sheets(i).Name & " 工作表 [" & A.Address & "]"
- Debug.Print A(2, XX)
- Debug.Print "字元:" & Len(A(2, XX))
- Msg = True
- End If
- Next
- If Msg Then
- Debug.Print
- Application.VBE.Windows("即時運算").Visible = True
- Stop
- Else
- Application.VBE.Windows("即時運算").Visible = False
- End If
- '************ 除錯結束 ****************************************
- Ar(S) = A.Offset(1).Resize(, 11) '將該列A:J欄寫入陣列
- S = S + 1
- End If
- Next
- End With
- Next
- .[A4].CurrentRegion.Offset(1).ClearContents '清除舊有資料
- If S > 0 Then .[A5].Resize(S, 11) = Application.Transpose(Application.Transpose(Ar)) '若有符合項目則寫入工作表1的A7以下位置
- End With
- End Sub
|
|
|
|
|
|
|
|
- 帖子
- 181
- 主題
- 5
- 精華
- 0
- 積分
- 197
- 點名
- 0
- 作業系統
- XP
- 軟體版本
- 2000
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2014-3-9
- 最後登錄
- 2024-4-29
|
2#
發表於 2014-12-26 07:45
| 只看該作者
經測試 Application.Transpose
可能是 bug 或 有限制陣列數量
以下範例
ReDim a(1 To 11, 0 To 495) ' ------- ok
g = Application.Transpose(a)
ReDim a(1 To 11, 0 To 496) ' ------ err msg 型態不符
g = Application.Transpose(a) |
|
|
|
|
|
|
|
