- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 198
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-8-13
               
|
回復 5# y663258
不知樓主是不是這個意思- Sub Ex()
- Dim A As Range, Ar(31), Ay()
- Set d = CreateObject("Scripting.Dictionary")
- With Sheet1
- For Each A In .Range(.[P2], .[P65536].End(xlUp))
- If A.Offset <> "" Then
- If d(A.Value) = "" Then
- d(A.Value) = A.Offset(, 1)
- Else
- d(A.Value) = d(A.Value) & "," & A.Offset(, 1)
- End If
- End If
- Next
- End With
- For Each ky In d.keys
- mystr = Split(d(ky), ",")
- Ar(0) = ky: Ar(1) = "95-013-4-001": Ar(3) = "大型"
- For i = 0 To UBound(mystr)
- Ar(i + 4) = mystr(i)
- Next
- If d(ky) <> "" Then
- Ar(24) = Mid(mystr(0), 1, 2): Ar(26) = Val(Mid(mystr(0), 1, 2)): Ar(27) = Mid(mystr(0), 1, 2)
- Ar(28) = Mid(mystr(0), 1, 2) * 2: Ar(29) = 373.5: Ar(30) = Ar(28) * Ar(29) / 100000
- End If
- ReDim Preserve Ay(x)
- Ay(x) = Ar
- x = x + 1
- Erase Ar
- Next
- Sheet2.[C5:Ay65536] = ""
- Sheet2.[B5].Resize(x, 31) = Application.Transpose(Application.Transpose(Ay))
- End Sub
|
|
發表於 2010-5-19 22:41
| 