[發問] 懇請高手教學

各位學長好
小弟有一事想請教

在製站別明細表-轉換.zip (111.78 KB)
如檔案內容
小弟已經寫好，使用多迴圈方式
將分頁(原始檔案)的文字
行列轉換並貼到分頁(轉換結果)
但有問題的是
1.料號製程合計: 的名稱迴圈我避不掉，必須要用另外的方式刪除。
2.目前的寫法欄位如果沒有超過E欄位迴圈就會卡住(無限輪迴)。
3.承上!資料從系統中倒出來的只會顯示到E欄位。
4.請問一下VBA 有自動樞紐變更範圍的方式嗎?? 資料更新之後樞紐會變要手動重新更新範圍，我用錄製巨集及上網找過都看不懂
以上 !!還請賜教!!
謝謝!!

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

4^#

發表於 2023-11-30 07:59 | 只看該作者

回復 2# 准提部林

謝謝論壇,謝謝前輩指導
後學藉此帖學習前輩的方案,學習心得註解如下,請前輩再指導

資料表:

執行結果:

納入名稱:

Sub 轉換()
Dim Arr, Brr, i&, R&, N&, j%, T1$, T2$
'↑宣告變數:(Arr,Brr)通用型變數,(i,R,N)長整數,j短整數,(T1,T2)字串變數
Arr = Sheets("原始檔案").UsedRange
'↑令Arr變數是裝入 "原始檔案"工作表有使用儲存格值的二維陣列
ReDim Brr(1 To 50000, 1 To 4)
'↑宣告Brr是二維空陣列,縱向索引號(1~500000),橫向索引號(1~4)
For i = 1 To UBound(Arr)
'↑設順迴圈!i從1 到Arr陣列縱向最大索引列號
If Arr(i, 1) = "料件編號" Then R = i: GoTo i01
'↑如果i迴圈列1欄Arr陣列值是 "料件編號"字串?
'True就令R變數同i變數值 (這是要記錄每個段落的工作站名稱所在的列號)
'最後跳到標示 i01位置繼續執行
If Not Arr(i, 4) Like "JM##-#########" Then GoTo i01
'↑如果i迴圈列4欄Arr陣列值不是 "JM##-#########"規則的字串?
'True就跳到標示 i01位置繼續執行
For j = 5 To UBound(Arr, 2)
'↑設順迴圈!j從5 到Arr陣列橫向最大索引欄號
      If Val(Arr(i, j)) = 0 Then GoTo j01
      '↑如果i迴圈列j迴圈欄Arr陣列值轉成的數值是 0,就跳到標示 j01位置繼續執行
      N = N + 1
      '↑令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)
      '↑令Arr陣列資料寫入Brr陣列中
j01: Next j
i01: Next i
Call 清除: If N = 0 Then Exit Sub
'↑執行副程式 Sub 清除()
'如果N變數是0 (代表N變數是所宣告的長整數初始值 0),就結束程式執行
[轉換結果!A2].Resize(N, 4) = Brr
'↑將Brr陣列值寫入儲存格中
[轉換結果!A1].Resize(N + 1, 4).Name = "My_Data"
'↑令指定範圍儲存格以 "My_Data" 字串為名,納入名稱中
End Sub

Sub 清除()
With Sheets("轉換結果")
   If .AutoFilterMode Then .AutoFilterMode = False
   '↑如果有自動篩選功能? True就令篩選功能關閉
   https://learn.microsoft.com/zh-t ... heet.autofiltermode
   .UsedRange.Offset(1, 0).EntireRow.Delete
   '↑令除了標題列以外的已使用儲存格刪除
End With
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

fantersy

中學生 Rank: 2

帖子: 132
主題: 35
精華: 0
積分: 179
點名: 0
作業系統: Windows
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2014-12-24
最後登錄: 2024-8-2

3^#

發表於 2021-11-15 18:09 | 只看該作者

回復 2# 准提部林
感謝!!准大
迴圈好短!!好厲害!!

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

2^#

發表於 2021-11-13 15:50 | 只看該作者

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",
樞紐分析表只要使用這個名稱當來源, 手動更新即可!

===============================

TOP