dear all 大大
1.如圖一問題.前輩解答如圖二
1.1 例 以NET10為例  產生  NET10:A01-A02    NET10:A01-A03
以NET13為例  產生  NET13:A01-A02    NET13:A01-A03   NET13:A01-A04
2.問題點如下-如圖三若B欄非 A01  A02 A03型態. 而是全部為A01
但仍以第一組  A01為基準.與其他同NET A01同圖三原則.請問圖二程式如何修改
1.1 例 以NET10為例  產生  NET10:首組A01-第2組A01    NET10:首組A01-第3組A01
以NET13為例  產生  NET13:首組A01-第2組A00    NET13:首組A01-第3組A01   NET13:首組A01-第4組A01
3.煩不吝賜教  THNKS*10000

DEAR ALL 大大
1.A資料庫依原則轉置B資料庫-問題尋問 說明如下 (公司電腦-無法上傳檔案SORRY)
2.SHEET1 資料如下
RANGE("A1")=NET10&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("B1")=A01&nbsp; &nbsp;&nbsp;&nbsp;RANGE("C1")=1&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("D1")=1
RANGE("A2")=NET10&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("B2")=A02&nbsp; &nbsp;&nbsp;&nbsp;RANGE("C2")=2&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("D2")=2&nbsp;&nbsp;
RANGE("A3")=NET10&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("B3")=A03&nbsp; &nbsp;&nbsp;&nbsp;RANGE("C3")=3&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("D3")=3&nbsp;&nbsp;
RANGE("A6")=NET13&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("B6")=A01&nbsp; &nbsp;&nbsp;&nbsp;RANGE("C6")=4&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("D6")=4&nbsp;&nbsp;
RANGE("A7")=NET13&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("B7")=A02&nbsp; &nbsp;&nbsp;&nbsp;RANGE("C7")=5&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("D7")=5&nbsp;&nbsp;
RANGE("A8")=NET13&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("B8")=A03&nbsp; &nbsp;&nbsp;&nbsp;RANGE("C8")=6&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("D8")=6&nbsp;&nbsp;
RANGE("A9")=NET13&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("B9")=A04&nbsp; &nbsp;&nbsp;&nbsp;RANGE("C9")=7&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;RANGE("D9")=7&nbsp;&nbsp;
2.1 原則1&nbsp;&nbsp;A欄同內容為同一組 (例 :&nbsp;&nbsp;NET10為同一組 NET13為同一組 )
&nbsp; &nbsp;&nbsp; &nbsp;原則2&nbsp;&nbsp;B欄 A01為主KEY. 與 非A01 配組轉置新SHEET2.

Sub TEST()
Dim Arr, Brr, xD, i&, T\$, U, a, b, N&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Sheet1!d1], [Sheet1!a65536].End(3))
For i = 1 To UBound(Arr)
T = Arr(i, 1) & IIf(Arr(i, 2) = "A01", "", "|")
xD(T) = Trim(xD(T) & " " & i)
Next i
ReDim Brr(1 To 30000, 1 To 4)
For Each U In xD.keys
If xD(U & "|") = "" Then GoTo 101
For Each a In Split(xD(U), " ")
For Each b In Split(xD(U & "|"), " ")
N = N + 2
For i = 1 To 4
Brr(N - 1, i) = Arr(a, i)
Brr(N, i) = Arr(b, i)
Next
Next
Next
101:  Next
[Sheet2!A1:D1].Resize(N) = Brr
End Sub

DEAR ALL 大大
1.A資料庫依原則轉置B資料庫-問題尋問 說明如下 (公司電腦-無法上傳檔案SORRY)
2.SHEET1 資料如下
RANGE("A1")=NET10        RANGE("B1")=A01     RANGE("C1")=1        RANGE("D1")=1
RANGE("A2")=NET10        RANGE("B2")=A01     RANGE("C2")=2        RANGE("D2")=2
RANGE("A3")=NET10        RANGE("B3")=A01     RANGE("C3")=3        RANGE("D3")=3
RANGE("A6")=NET13        RANGE("B6")=A01     RANGE("C6")=4        RANGE("D6")=4
RANGE("A7")=NET13        RANGE("B7")=A01     RANGE("C7")=5        RANGE("D7")=5
RANGE("A8")=NET13        RANGE("B8")=A01     RANGE("C8")=6        RANGE("D8")=6
RANGE("A9")=NET13        RANGE("B9")=A01     RANGE("C9")=7        RANGE("D9")=7
2.1 原則1  A欄同內容為同一組 (例 :  NET10為同一組 NET13為同一組 )
原則2  B欄第一個 A01為主KEY. 與 其餘A01 配組轉置新SHEET2.

 歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)