Board logo

標題: [發問] A資料庫依原則轉置B資料庫-問題尋問 [打印本頁]

作者: rouber590324    時間: 2020-11-9 10:10     標題: A資料庫依原則轉置B資料庫-問題尋問

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        RANGE("B1")=A01     RANGE("C1")=1        RANGE("D1")=1
RANGE("A2")=NET10        RANGE("B2")=A02     RANGE("C2")=2        RANGE("D2")=2  
RANGE("A3")=NET10        RANGE("B3")=A03     RANGE("C3")=3        RANGE("D3")=3  
RANGE("A6")=NET13        RANGE("B6")=A01     RANGE("C6")=4        RANGE("D6")=4  
RANGE("A7")=NET13        RANGE("B7")=A02     RANGE("C7")=5        RANGE("D7")=5  
RANGE("A8")=NET13        RANGE("B8")=A03     RANGE("C8")=6        RANGE("D8")=6  
RANGE("A9")=NET13        RANGE("B9")=A04     RANGE("C9")=7        RANGE("D9")=7  
2.1 原則1  A欄同內容為同一組 (例 :  NET10為同一組 NET13為同一組 )
      原則2  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/)