- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2011-8-28 15:56
| 只看該作者
回復 1# john2006168
使用Dictionary 物件 試試看- Sub Ex()
- Dim D As Object, E, S As String, S1 As String
- Set D = CreateObject("SCRIPTING.DICTIONARY")
- With Sheets("Sheet2")
- For Each E In .Range("E2", .[E2].End(xlDown))
- If D.EXISTS(E.Value) = False Then
- D(E.Value) = Array(E.Offset(, -3), E.Offset(, -4))
- Else
- S = "," & D(E.Value)(0) & ","
- If InStr(S, "," & E.Offset(, -3) & ",") = 0 Then
- S = D(E.Value)(0) & "," & E.Offset(, -3)
- Else
- S = D(E.Value)(0)
- End If
- S1 = "," & D(E.Value)(1) & ","
- If InStr(S1, "," & E.Offset(, -4)) & "," = 0 Then
- S1 = D(E.Value)(1) & "," & E.Offset(, -4)
- Else
- S1 = D(E.Value)(1)
- End If
- D(E.Value) = Array(S, S1)
- End If
- Next
- End With
- With Sheets("Sheet1")
- For Each E In .Range("C3", .[C3].End(xlDown))
- If D.EXISTS(E.Value) Then
- E.Offset(, 9) = D(E.Value)(0)
- E.Offset(, 10) = D(E.Value)(1)
- Else
- E.Offset(, 9) = "No received"
- E.Offset(, 10) = ""
- End If
-
- Next
- End With
- End Sub
複製代碼 |
|