請教Excel函數設定(vlook、if)的問題，並且將檔案變更為指定格式

目前有一大筆資需要去判斷其號碼，並且改為橫式

原始檔範例:
號碼                         貨號
AQ27304209       62055202
AQ27304210       62009257
AQ27304210       62111432
AQ27304216       62025522
AQ27304216       5032465
AQ27304216       62074097

需要在excel內改為這樣的格式
AQ27304209       62055202       62045456       62105993
AQ27304210       62009257       62111432
AQ27304216       62025522       5032465       62074097

目前除了遇到VLOOKUP只能對齊一組號碼以外，還有我沒辦法確定同一組AQ號碼，到底包含1組或者很多組的號碼，所以這蠻麻煩的
由於資料量很大，需要設定函數讓電腦自己去處理，且無法設巨集(資料量大，跑太慢)
不知道各位前輩有無好的函數設定方法?或者excel好用的工具可推薦

201412-1(巨集) 範本說明.zip (13.16 KB)

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2843
主題: 10
精華: 0
積分: 2899
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2025-10-18

2^#

發表於 2016-2-25 10:12 | 只看該作者

由於資料量很大，需要設定函數讓電腦自己去處理，且無法設巨集(資料量大，跑太慢)

大量資料，用vba是最好方法，不過無法隨時更新，而用按鈕處理，但不理解為何〔無法設巨集〕？
若用公式，除了用〔輔助欄〕可以稍微優化速度，直接陣列公式會卡是無法避免的！

TOP

0989575670

中學生 Rank: 2

帖子: 16
主題: 4
精華: 0
積分: 55
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2016-2-24
最後登錄: 2023-7-24

3^#

發表於 2016-2-25 12:48 | 只看該作者

因為之前用錄製+巨集，但速度很慢(可能是我設定的問題)

可否請版主或各位大大指示一下該如何操作，讓我試試看

因為這點我真的卡了好久....

TOP

yen956

高中生 Rank: 3 Rank: 3

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

4^#

發表於 2016-2-25 13:09 | 只看該作者

試試VBA, 請貼在工作表"201412-1"(不是Modula1)
Sub test()
Dim sh As Worksheet
Dim I As Integer, Lst As Integer
Dim d, Rng As Range, E, Cnt
Set d = CreateObject("Scripting.Dictionary")
Set sh = Sheets("工作表1")
Lst = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = [A2].Resize(Lst - 1, 1)
sh.Cells.Clear          '清除"工作表1"

'複製標題到"工作表1"(暫定6欄"貨號", 可自調最後一個6)
[A1:B1].Copy sh.[A1]: sh.[B1].Copy sh.[B1].Resize(1, 6)

For Each E In Rng
      d.Item(E.Value) = "" '用 Dictionary 的不重覆性篩選"號碼"
Next
sh.[A2].Resize(d.Count) = Application.Transpose(d.Keys) '複製"不重覆號碼" 到 "工作表1"

Set Rng = sh.[A2].Resize(d.Count, 1)
ReDim Cnt(1 To d.Count) As Integer
For I = 2 To Lst
      MH = Application.Match(Cells(I, 1), Rng)
      If Application.IsNumber(MH) Then
         Cnt(MH) = Cnt(MH) + 1
         sh.Cells(MH + 1, Cnt(MH) + 1) = Cells(I, 1).Offset(0, 1)
      End If
Next
End Sub

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2843
主題: 10
精華: 0
積分: 2899
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2025-10-18

5^#

發表於 2016-2-25 20:38 | 只看該作者

Sub TEST()
Dim Arr, Brr, T$, N&, xD, Dr, X%, i&
Arr = Range([A1], Cells(Rows.Count, 2).End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 200)
Set xD = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Arr)
　　If Arr(i, 1) = "" Or Arr(i, 2) = "" Then GoTo 101
　　T = Arr(i, 1): Dr = xD(T)
　　If Not IsArray(Dr) Then N = N + 1: Dr = Array(N, 0): Brr(N, 1) = T
　　Dr(1) = Dr(1) + 1: If Dr(1) > X Then X = Dr(1)
　　Brr(Dr(0), Dr(1) + 1) = Arr(i, 2): xD(T) = Dr
101: Next i
　
With [工作表1!A1].Resize(N + 1, X + 1)
　　.Parent.UsedRange.Clear
　　.Cells(2, 1).Resize(N, X + 1) = Brr
　　.Item(1) = Arr(1, 1)
　　.Item(2).Resize(1, X) = "=""" & Arr(1, 2) & "-""&COLUMN(a1)"
　　.Borders.LineStyle = 1
　　Application.Goto .Item(1)
End With
End Sub
　
寫得囉嗦些，用看看：