- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 4# 千暉尋 - Option Explicit
- Sub A新DP判斷()
- Dim CL As Integer, CR2 As Integer, D1 As Integer, D2 As Integer, D As Object
- Dim ar(), X As Integer, E As Variant
- CL = Application.Match("C/L", [a1:a300], 0) 'C/L所在列數
- CR2 = Application.Match("CUP PRINT", [a1:a100], 0)
- D1 = Application.Match("D/P", [a1:a300], 0) + 2 'D/P資料區首列(不含標題列)
- D2 = Cells(CR2, 1).End(3).Row 'D/P資料區末列
- [I:AD].Clear:
- ar = Range(Cells(D1, 1), Cells(D2, 9))
- Set D = CreateObject("Scripting.Dictionary")
- For X = 1 To UBound(ar) '將OS資料入陣列,item 則以"-"將OS串接
- D(ar(X, 3)) = D(ar(X, 3)) & "+" & ar(X, 2)
- Next
- If D.Count = 0 Then Exit Sub
- '***改橫放不使用>>Application.Transpose
- Cells(D1, "J").Resize(, D.Count) = D.keys ''金額欄
- Cells(D1 + 1, "j").Resize(, D.Count) = D.ItemS ''OS欄
- '直放 **如陣列中元素的字元數有>255 元素 >> 需一一的導出
- X = 1
- For Each E In D.keys
- Cells(D1 + 3, "j").Range("A" & X) = E
- Cells(D1 + 3, "k").Range("A" & X) = D(E)
- X = X + 1
- Next
- '*** '***橫放 使用>>Application.Transpose*********************************
- Cells(D1 + 3, "L").Resize(D.Count, 1) = Application.Transpose(D.keys) '金額欄
- '陣列中元素的字元數有>255 '**使用Application.Transpose會發生錯誤
- ar = D.ItemS
- ar(0) = Mid(ar(0), 1, 256) 'OS欄 -->報錯 改為 ar(0) = Mid(ar(0), 1, 255)看看
- Cells(D1 + 3, "M").Resize(D.Count, 1) = Application.Transpose(ar) ''OS欄 -->報錯
- End Sub
|
|
發表於 2019-9-16 08:45
| 