- 帖子
- 2848
- 主題
- 10
- 精華
- 0
- 積分
- 2903
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2026-4-29
|
Sub 轉換()
Dim Arr, Brr, i&, j%, R&, T1$, T2$, N&
Arr = Sheets("原始檔案").UsedRange
ReDim Brr(1 To 50000, 1 To 4)
For i = 1 To UBound(Arr)
If Arr(i, 1) = "料件編號" Then R = i: GoTo i01
If Not Arr(i, 4) Like "JM##-#########" Then GoTo i01
For j = 5 To UBound(Arr, 2)
If Val(Arr(i, j)) = 0 Then GoTo j01
N = N + 1
Brr(N, 1) = Arr(i, 1): Brr(N, 2) = Arr(i, 4)
Brr(N, 3) = Arr(R, j): Brr(N, 4) = Arr(i, j)
j01: Next j
i01: Next i
Call 清除: If N = 0 Then Exit Sub
[轉換結果!A2].Resize(N, 4) = Brr
[轉換結果!A1].Resize(N + 1, 4).Name = "My_Data"
End Sub
Sub 清除()
With Sheets("轉換結果")
If .AutoFilterMode Then .AutoFilterMode = False
.UsedRange.Offset(1, 0).EntireRow.Delete
End With
End Sub
 Xl0000001.rar (52.78 KB)
轉換結果的資料區(含標題), 定義為"My_Data",
樞紐分析表只要使用這個名稱當來源, 手動更新即可!
=============================== |
|
發表於 2021-11-13 15:50
| 