懇請高手教學
各位學長好小弟有一事想請教
[attach]34378[/attach]
如檔案內容
小弟已經寫好，使用多迴圈方式
將分頁(原始檔案)的文字
行列轉換並貼到分頁(轉換結果)
但有問題的是
1.料號製程合計: 的名稱 迴圈我避不掉，必須要用另外的方式 刪除。
2.目前的寫法 欄位如果沒有超過E欄位 迴圈就會卡住(無限輪迴)。
3.承上!資料從系統中倒出來的只會顯示到E欄位。
4.請問一下VBA 有自動 樞紐變更範圍的方式嗎?? 資料更新之後 樞紐會變 要手動重新更新範圍，我用錄製巨集及上網找過 都看不懂
以上 !!還請賜教!!
謝謝!! 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
[attach]34384[/attach]
轉換結果的資料區(含標題), 定義為"My_Data",
樞紐分析表只要使用這個名稱當來源, 手動更新即可!
=============================== [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117685&ptid=23479]2#[/url] [i]准提部林[/i] [/b]
感謝!!准大
迴圈好短!!好厲害!! [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117685&ptid=23479]2#[/url] [i]准提部林[/i] [/b]
謝謝論壇,謝謝前輩指導
後學藉此帖學習前輩的方案,學習心得註解如下,請前輩再指導
資料表:
[attach]37079[/attach]
執行結果:
[attach]37080[/attach]
納入名稱:
[attach]37081[/attach]
Sub 轉換()
Dim Arr, Brr, i&, R&, N&, j%, T1$, T2$
[color=SeaGreen]'↑宣告變數:(Arr,Brr)通用型變數,(i,R,N)長整數,j短整數,(T1,T2)字串變數[/color]
Arr = Sheets("原始檔案").UsedRange
[color=SeaGreen]'↑令Arr變數是裝入 "原始檔案"工作表有使用儲存格值的二維陣列[/color]
ReDim Brr(1 To 50000, 1 To 4)
[color=SeaGreen]'↑宣告Brr是二維空陣列,縱向索引號(1~500000),橫向索引號(1~4)[/color]
For i = 1 To UBound(Arr)
[color=SeaGreen]'↑設順迴圈!i從1 到Arr陣列縱向最大索引列號[/color]
If Arr(i, 1) = "料件編號" Then R = i: GoTo i01
[color=SeaGreen] '↑如果i迴圈列1欄Arr陣列值是 "料件編號"字串?
'True就令R變數同i變數值 (這是要記錄每個段落的工作站名稱所在的列號)
'最後跳到標示 i01位置繼續執行[/color]
If Not Arr(i, 4) Like "JM##-#########" Then GoTo i01
[color=SeaGreen] '↑如果i迴圈列4欄Arr陣列值不是 "JM##-#########"規則的字串?
'True就跳到標示 i01位置繼續執行[/color]
For j = 5 To UBound(Arr, 2)
[color=SeaGreen] '↑設順迴圈!j從5 到Arr陣列橫向最大索引欄號[/color]
If Val(Arr(i, j)) = 0 Then GoTo j01
[color=SeaGreen] '↑如果i迴圈列j迴圈欄Arr陣列值轉成的數值是 0,就跳到標示 j01位置繼續執行[/color]
N = N + 1
[color=SeaGreen] '↑令N變數累加1 (寫入資料的索引列號)[/color]
Brr(N, 1) = Arr(i, 1): Brr(N, 2) = Arr(i, 4)
Brr(N, 3) = Arr(R, j): Brr(N, 4) = Arr(i, j)
[color=SeaGreen] '↑令Arr陣列資料 寫入Brr陣列中[/color]
j01: Next j
i01: Next i
Call 清除: If N = 0 Then Exit Sub
[color=SeaGreen]'↑執行副程式 Sub 清除()[/color]
[color=SeaGreen]'如果N變數是0 (代表N變數是所宣告的長整數初始值 0),就結束程式執行[/color]
[轉換結果!A2].Resize(N, 4) = Brr
[color=SeaGreen]'↑將Brr陣列值寫入儲存格中[/color]
[轉換結果!A1].Resize(N + 1, 4).Name = "My_Data"
[color=SeaGreen]'↑令指定範圍儲存格以 "My_Data" 字串為名,納入名稱中[/color]
End Sub
Sub 清除()
With Sheets("轉換結果")
If .AutoFilterMode Then .AutoFilterMode = False
[color=SeaGreen] '↑如果有自動篩選功能? True就令篩選功能關閉[/color]
[url]https://learn.microsoft.com/zh-tw/office/vba/api/excel.worksheet.autofiltermode[/url]
.UsedRange.Offset(1, 0).EntireRow.Delete
[color=SeaGreen] '↑令除了標題列以外的已使用儲存格刪除[/color]
End With
End Sub
頁:
[1]