返回列表下一主題上一主題發帖

[發問] A資料庫依原則轉置B資料庫-問題尋問

rouber590324

高中生 Rank: 3 Rank: 3

帖子: 561
主題: 160
精華: 0
積分: 725
點名: 0
作業系統: WINDOWS
軟體版本: xp
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2014-9-10
最後登錄: 2024-8-7

論壇榮譽勳章論壇贊助勳章熱烈參與勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 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.

樓主熱帖

羅

靜思自在 : 難行能行，難捨能捨，難為能為，才能昇華自我的人格。

返回列表下一主題上一主題