- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 106
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-5-8
              
|
23#
發表於 2013-3-9 23:29
| 只看該作者
本帖最後由 Hsieh 於 2013-3-10 10:14 編輯
回復 22# 198188
這樣的程式與樓上程式碼比較看看應該就容易了解- Sub ex()
- Dim Sh As Worksheet, Rng As Range, C As Range, Ar()
- fd = ThisWorkbook.Path & "\" '資料來源目錄
- fs = "DOCS RECEIVED N RELEASED RECORD.xlsx" '資料來源檔案(含副檔名)
- With Workbooks.Open(fd & fs)
- Set Sh = .Sheets("收件記錄")
- With ThisWorkbook.Sheets("State")
- For Each A In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
- Set Rng = Sh.Columns("D").Find(A, lookat:=xlWhole)
- If Not Rng Is Nothing Then
- For Each C In Sh.Range(Rng, Sh.Cells(Sh.Rows.Count, 4).End(xlUp))
- If C = A And InStr(UCase(C.Offset(, 4).MergeArea(1)), "OBL") > 0 Then
- ReDim Preserve Ar(s)
- Ar(s) = C.Offset(, 4).MergeArea(1)
- s = s + 1
- End If
- Next
- If s > 0 And A.Offset(, 9) = "" Then
- A.Offset(, 9) = Join(Ar, "、")
- Erase Ar
- s = 0
- Else
- A.Offset(, 9) = ""
- End If
- End If
- Next
- End With
- .Close
- End With
- End Sub
|
|
發表於 2013-3-10 20:34
| 
