請教Excel函數設定(vlook、if)的問題，並且將檔案變更為指定格式
- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
試試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 |
|
|
|
|
|
|
|
發表於 2016-2-25 13:09
| 