如何透過寫程式之方式將ab欄位整合
請問如何將(一)之資料透過寫程式之方式轉換成(二),A~D代表公司名稱是一樣的、1~10代表每一個不同的部門名稱。(一) (二)
公司名稱 部門名稱 公司名稱 部門名稱 部門名稱 部門名稱 部門名稱
A 1 A 1 2 3
A 2 B 4 5
A 3 C 6
B 4 → D 7 8 9 10
B 5
C 6
D 7
D 8
D 9
D 10 [i=s] 本帖最後由 oobird 於 2011-10-29 11:25 編輯 [/i]
你好:
請試試如下:[code]Sub bb()
Dim mSht As Worksheet
Dim mRng As Range, E As Range
Dim ar, mSplit
Dim mDic As Object
Dim s%, s1%, s2%
Set mDic = CreateObject("scripting.dictionary")
Set mSht = Worksheets(1)
With mSht
Set mRng = .Range("a1", .Range("a" & .Rows.Count).End(xlUp))
For Each E In mRng
If Not mDic.Exists(E.Value) Then
mDic(E.Value) = E.Offset(, 1).Value
Else
mDic(E.Value) = mDic(E.Value) & "," & E.Offset(, 1)
End If
Next
s = 1
s1 = 10
For Each ar In mDic.Keys
.Cells(s, s1) = ar
mSplit = Split(mDic(ar), ",")
For s2 = 0 To UBound(mSplit)
.Cells(s, s1 + 1) = mSplit(s2)
.Cells(1, s1 + 1) = "部門名稱"
s1 = s1 + 1
Next
s = s + 1
s1 = 10
Next
End With
End Sub[/code] [code]Sub test()
Dim d As Object, a, b(100), m%, i%
Set d = CreateObject("scripting.dictionary")
a = Range([a1], [b65536].End(3))
ReDim arr(1 To UBound(a), 1 To UBound(a))
For i = 1 To UBound(a)
If Not d.exists(a(i, 1)) Then
m = m + 1
d(a(i, 1)) = m
arr(m, 1) = a(i, 1): arr(m, 2) = a(i, 2): b(m) = 2
Else
b(m) = b(m) + 1
arr(d(a(i, 1)), b(m)) = a(i, 2)
x = IIf(b(m) > x, b(m), x)
End If
Next
If x > 2 Then
For i = 3 To x
arr(1, i) = arr(1, 2)
Next
End If
[d1].Resize(m, x) = arr
End Sub
[/code] 多謝大大的詳解~我已經試成功嚕 ^.^ 謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行前:
[attach]36410[/attach]
執行結果:
[attach]36411[/attach]
Option Explicit
Sub TEST()
Dim Brr, Crr, Y, i&, T$, M%
[color=SeaGreen]'↑宣告變數[/color]
Set Y = CreateObject("Scripting.Dictionary")
[color=SeaGreen]'↑令Y變數是 字典[/color]
Brr = Range([B1], [A65536].End(xlUp))
[color=SeaGreen]'↑令Brr變數是 二維陣列,以A.B欄儲存格值帶入陣列中[/color]
ReDim Crr(1 To UBound(Brr), 1 To 100)
[color=SeaGreen]'↑令宣告Crr變數是 二維空陣列,縱向範圍同Brr陣列,橫向索引號1~100[/color]
For i = 1 To UBound(Brr)
[color=SeaGreen]'↑設順迴圈!從1到Brr陣列縱向最大索引列號[/color]
T = Brr(i, 1)
[color=SeaGreen] '↑令T變數是 i迴圈第1欄Brr陣列值[/color]
If Y(T) = "" Then
[color=SeaGreen] '↑如果T變數查Y字典的item值是"" ?[/color]
Y(T) = Y.Count
[color=SeaGreen] '↑令Y字典的T變數key的item值是 Y字典key的數量[/color]
Crr(Y(T) \ 2 + 1, 1) = T
[color=SeaGreen] '↑令Crr陣列放入T變數[/color]
Y(T & "/C") = 1
[color=SeaGreen] '↑令T變數連接"/C"組成的新字串當key,item是1,納入Y字典中[/color]
End If
Y(T & "/C") = Y(T & "/C") + 1
[color=SeaGreen] '↑令Y字典中(T變數連接"/C"組成字串)key,其item值累加1
'這是要在Y字典中記錄T變數欄號[/color]
Crr(Y(T) \ 2 + 1, Y(T & "/C")) = Brr(i, 2)
[color=SeaGreen] '↑令Crr陣列在適當位置放入 i迴圈第2欄Brr陣列值[/color]
If Y(T & "/C") > M Then
[color=SeaGreen] '↑如果Y字典中記錄T變數欄號大於M變數[/color]
M = Y(T & "/C")
[color=SeaGreen] '↑就讓M變數換裝變數欄號[/color]
Crr(1, M) = Brr(1, 2)
[color=SeaGreen] '↑令在Crr陣列第1列M欄號位置添加一個"部門名稱"標題[/color]
End If
Next
[E1].Resize(Y.Count \ 2 + 1, M) = Crr
[color=SeaGreen]'↑令Crr陣列值從[E1]開始寫入儲存格中[/color]
Set Y = Nothing: Erase Brr, Crr
[color=SeaGreen]'↑令釋放變數[/color]
End Sub
頁:
[1]