執行階段錯誤13 - Excel程式區 - 麻辣家族討論版版

帖子: 2798
主題: 10
精華: 0
積分: 2854
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-4-15

8^# 跳轉到 »

發表於 2019-10-3 10:03 | 只看該作者

回復 6# jesscc

兩種合併一次迴圈完成:
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
For Each T In Range([T7], [T300].End(xlUp))
If d(T & "") = "" Then
   d(T & "") = T(, -5) & " " & T(, -3) & " " & T(, -2)
   d1(T & "") = T(, -4) & " " & T(, 3) & " " & T(, -2)
Else
   d(T & "") = d(T & "") & ", " & T(, -5) & " " & T(, -3) & " " & T(, -2)
   d1(T & "") = d1(T & "") & ", " & T(, -4) & " " & T(, 3) & " " & T(, -2)
End If
Next
ReDim Arr(1 To d.Count, 0), Brr(1 To d.Count, 1 To 2)
For Each k In d.keys
N = N + 1
Arr(N, 0) = k
Brr(N, 1) = d(k)
Brr(N, 2) = d1(k)
Next
[Y7].Resize(N, 1) = Arr
[AF7].Resize(N, 2) = Brr

=======================================

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2798
主題: 10
精華: 0
積分: 2854
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-4-15

7^#

發表於 2019-10-3 09:48 | 只看該作者

本帖最後由准提部林於 2019-10-3 09:51 編輯

回復 6# jesscc

'中文品項合併
Set d = CreateObject("Scripting.Dictionary")
For Each T In Range([T7], [T300].End(xlUp))
If d(T.Value) = "" Then
   d(T.Value) = T.Offset(, -6) & " " & T.Offset(, -4) & " " & T.Offset(, -3)
   Else
   d(T.Value) = d(T.Value) & ", " & T.Offset(, -6) & " " & T.Offset(, -4) & " " & T.Offset(, -3)

End If
Next
ReDim Arr(1 To d.Count, 0), Brr(1 To d.Count, 0)
For Each k In d.keys
N = N + 1: Arr(N, 0) = k: Brr(N, 0) = d(k)
Next
[Y7].Resize(N, 1) = Arr
[AF7].Resize(N, 1) = Brr

'=========================================
'英文品項合併
Set d1 = CreateObject("Scripting.Dictionary")
For Each T In Range([T7], [T300].End(xlUp))
If T.Offset(, 2) = "" Then GoTo AA
If d1(T.Value) = "" Then
   d1(T.Value) = T.Offset(, -5) & " " & T.Offset(, 2) & " " & T.Offset(, -3)
   Else
   d1(T.Value) = d1(T.Value) & ", " & T.Offset(, -5) & " " & T.Offset(, 2) & " " & T.Offset(, -3)
End If
AA: Next
N = 0: ReDim Arr(1 To d1.Count, 0)
For Each k In d1.items
N = N + 1: Arr(N, 0) = k
Next
[AG7].Resize(N, 1) = Arr

將字典檔再做一次後置處理, 納入陣列即可~~

===============================

TOP

jesscc

中學生 Rank: 2

帖子: 162
主題: 44
精華: 0
積分: 244
點名: 0
作業系統: windows 7
軟體版本: office 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-4-4
最後登錄: 2022-10-3

論壇贊助勳章

6^#

發表於 2019-10-2 23:02 | 只看該作者

回復 5# Kubi
感謝K大，我爬了很多文，也確認了這一點。但是現在有個頭疼的地方，因為我的代碼裏還有其他幾個地方都用了Transpose這個轉置函數，將來可能會瘋狂偵錯，該如何改寫呢?准大兩個陣列並用的寫法，幼兒園程度的我不太會用?附上更新的檔案，裏面有我原始的寫法。

test1.rar (31.11 KB)

Jess

TOP

Kubi

中學生 Rank: 2

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

5^#

發表於 2019-10-2 21:18 | 只看該作者

回復 3# jesscc

2010版的Excel Application.Transpose 有兩個罩門
1.置換的元素中若有超出256字元會產生錯誤。
2.置換的列數若超出65536列會產生錯誤。

執行你的程式碼後所得字元數資料如下：
嘜頭號34【中文品項合併】為21
嘜頭號34【英文品項合併】為16

嘜頭號35【中文品項合併】為161
嘜頭號35【英文品項合併】為138

嘜頭號36【中文品項合併】為211
嘜頭號36【英文品項合併】為306

嘜頭號37【中文品項合併】為176
嘜頭號37【英文品項合併】為170

嘜頭號38【中文品項合併】為8
嘜頭號38【英文品項合併】為3

資料錯誤出現在嘜頭號36【英文品項合併】為306，已超出256的上限，而所有中文品項均合乎規則，因此不會出錯。

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2798
主題: 10
精華: 0
積分: 2854
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-4-15

4^#

發表於 2019-10-2 13:45 | 只看該作者

回復 3# jesscc

這文字長度如何讓transpose產生錯誤, 我也不清楚, 儘量不用~~

'英文品項合併
Dim Brr, N&, U&, TS$
Set d1 = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To [T300].End(xlUp).Row, 0) '定義一個陣列[容納器]
For Each T In Range([T7], [T300].End(xlUp))
If T(1, 3) = "" Or T(1, -4) = "" Then GoTo AA 'T格或英文品項為空--略過
TS = T(1, -4) & " " & T(1, 3) & " " & T(1, -2) '該行串接文字
U = d1(T & "") '取得字典檔相應的[序號]
If U > 0 Then Brr(U, 0) = Brr(U, 0) & "," & TS: GoTo AA '如果序號大于0, 進行第2筆以後的串接
N = N + 1: d1(T & "") = N: Brr(N, 0) = TS '如果序號為0, 序號遞增1存入字典檔, 填入第一個文字串
AA: Next
[AG7].Resize(N, 1) = Brr

==========================

TOP

jesscc