Hsieh

回復 12# 198188
會出現超出陣列索引錯誤是因為你在開啟來源檔以後，一般模組內程式碼若沒指定活頁簿，則會以當前作用中的活頁簿作為該活頁簿
通常我會這麼做，比較容易找出錯誤點

1. Sub ex()
   
2. Dim Sh As Worksheet, Rng As Range
   
3. fd = ThisWorkbook.Path & "\"  '資料來源目錄
   
4. fs = "DOCS RECEIVED N RELEASED RECORD.xlsx" '資料來源檔案(含副檔名)
   
5. With Workbooks.Open(fd & fs)
   
6.   Set Sh = .Sheets("收件記錄")
   
7.       With ThisWorkbook.Sheets("State")
   
8.          For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
   
9.             Set Rng = Sh.Columns("D").Find(A, lookat:=xlWhole)
   
10.             If Not Rng Is Nothing Then
    
11.                If InStr(Rng.Offset(, 4), "OBL") > 0 Then _
    
12.                A.Offset(, 9) = Rng.Offset(, 4).Value Else A.Offset(, 9) = ""
    
13.             End If
    
14.          Next
    
15.       End With
    
16.     .Close
    
17. End With
    
18. End Sub

複製代碼

Hsieh

回復 14# 198188

1. Sub ex()
   
2. Dim Sh As Worksheet, Rng As Range, C As Range, Ar()
   
3. fd = ThisWorkbook.Path & "\"  '資料來源目錄
   
4. fs = "DOCS RECEIVED N RELEASED RECORD.xlsx" '資料來源檔案(含副檔名)
   
5. With Workbooks.Open(fd & fs)
   
6.   Set Sh = .Sheets("收件記錄")
   
7.       With ThisWorkbook.Sheets("State")
   
8.          For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
   
9.             Set Rng = Sh.Columns("D").Find(A, lookat:=xlWhole)
   
10.             If Not Rng Is Nothing Then
    
11.                For Each C In Sh.Range(Rng, Sh.Cells(Sh.Rows.Count, 4).End(xlUp))
    
12.                   If C = A And InStr(UCase(C.Offset(, 4)), "OBL") > 0 Then
    
13.                      ReDim Preserve Ar(s)
    
14.                      Ar(s) = C.Offset(, 4)
    
15.                      s = s + 1
    
16.                   End If
    
17.                 Next
    
18.             If s > 0 Then A.Offset(, 9) = Join(Ar, "、"): Erase Ar: s = 0 Else A.Offset(, 9) = ""
    
19.             End If
    
20.          Next
    
21.       End With
    
22.     .Close
    
23. End With
    
24. End Sub

複製代碼

Hsieh

回復 19# 198188

如果我寫這句替代上面兩句fs = "W:\PIHK\DOCS RECEIVED N RELEASED RECORD.xlsx"
第5行這句
With Workbooks.Open(fd & fs)
就要改成
With Workbooks.Open(fs)

Join(Ar, "、"): Erase 這句是什麼意思？
程式語法不能只讀一半，在同一行敘述使用冒號，相當於兩行敘述
Join(Ar, "、") →  會得到陣列元素用頓號、連接的字串
Erase Ar →  是清空陣列

程式寫得對不對，執行一下就知道結果啦

Hsieh

回復 22# 198188
這樣的程式與樓上程式碼比較看看應該就容易了解

1. Sub ex()
   
2. Dim Sh As Worksheet, Rng As Range, C As Range, Ar()
   
3. fd = ThisWorkbook.Path & "\"  '資料來源目錄
   
4. fs = "DOCS RECEIVED N RELEASED RECORD.xlsx" '資料來源檔案(含副檔名)
   
5. With Workbooks.Open(fd & fs)
   
6.   Set Sh = .Sheets("收件記錄")
   
7.       With ThisWorkbook.Sheets("State")
   
8.          For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
   
9.             Set Rng = Sh.Columns("D").Find(A, lookat:=xlWhole)
   
10.             If Not Rng Is Nothing Then
    
11.                For Each C In Sh.Range(Rng, Sh.Cells(Sh.Rows.Count, 4).End(xlUp))
    
12.                   If C = A And InStr(UCase(C.Offset(, 4).MergeArea(1)), "OBL") > 0 Then
    
13.                      ReDim Preserve Ar(s)
    
14.                      Ar(s) = C.Offset(, 4).MergeArea(1)
    
15.                      s = s + 1
    
16.                   End If
    
17.                 Next
    
18.             If s > 0 And A.Offset(, 9) = "" Then
    
19.                A.Offset(, 9) = Join(Ar, "、")
    
20.                Erase Ar
    
21.                s = 0
    
22.                   Else
    
23.                A.Offset(, 9) = ""
    
24.             End If
    
25.             End If
    
26.          Next
    
27.       End With
    
28.     .Close
    
29. End With
    
30. End Sub

複製代碼

Hsieh

回復 24# 198188
善用F1說明與逐行偵錯才能對語法徹底了解
你問合併儲存格是否可行?
表示你根本沒有執行測試
沒有勇氣測試只會讓你永遠停頓
除非有證明樓上程式碼無法達成需求
且說明清楚問題點，否則此問題將不再回應

Hsieh

回復 26# 198188
你怎麼測試的?

下載 (747.03 KB)

2013-3-10 10:18

Hsieh

回復 32# 198188


    應該這句錯誤
Worksheets("OHC").Range("G" & i).Font.ColorIndex = RGB(217, 24, 9)
ColorIndex 應該是數值不可使用RGB
可改成
Worksheets("OHC").Range("G" & i).Font.Color = RGB(217, 24, 9)