- 帖子
- 2819
- 主題
- 10
- 精華
- 0
- 積分
- 2875
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-6-23
|
上傳檔案無法正常開啟(格式太多), 大約寫一下:注意工作表名稱是否相同- Sub TEST()
- Dim R&, C, N&, Arr, Brr, xD, i&, T$
- Sheets("工作表2").UsedRange.Offset(1, 0).Clear
- Arr = Range([工作表1!A2], [工作表1!A65536].End(xlUp)(1, 5))
- ReDim Brr(1 To UBound(Arr), 1 To 8)
- Set xD = CreateObject("Scripting.Dictionary")
- For i = 1 To UBound(Arr)
- T = Arr(i, 1): R = xD(T)
- If R = 0 Then
- N = N + 1: R = N: xD(T) = N
- Brr(R, 1) = Arr(i, 1): Brr(R, 2) = Arr(i, 2): Brr(R, 3) = Arr(i, 3)
- End If
- C = Application.Match(Arr(i, 4), Array("國語", "英文", "數學", "物理", "化學"), 0)
- Brr(R, C + 3) = Arr(i, 5)
- Next i
- [工作表2!A2].Resize(N, 8) = Brr
- End Sub
|
|
發表於 2016-9-1 12:30
| 