請教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)

樓主熱帖

0989575670

中學生 Rank: 2

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

7^#

發表於 2016-3-2 08:54 | 只看該作者

謝謝大家的幫忙，後續已經可以用VBA轉成橫式了~~~~

萬分感激!!

只不過我一個月的資料筆數差不多一百萬筆左右，所以需要點時間跑

嘆

當初應該要去學寫程式的)

TOP

學到老死

中學生 Rank: 2

帖子: 44
主題: 14
精華: 0
積分: 58
點名: 0
作業系統: Window 8
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2015-8-15
最後登錄: 2017-4-18

6^#

發表於 2016-2-29 23:51 | 只看該作者

A B
AQ27304209
   62055202

AQ27304210
   62009257
   62111432

AQ27304216
   5032465
   62025522
   62074097

總計

樞紐分析好像也可以但是排列成橫列好像無法

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

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
　
寫得囉嗦些，用看看：

Xl0000127.rar (19.48 KB)
　

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

0989575670