返回列表 上一主題 發帖

[發問] 出口文件_程式需求

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
1# 跳轉到 »
發表於 2023-4-26 11:43 | 顯示全部帖子
回復 4# PJChen


    謝謝論壇,謝謝前輩發表此帖與範例
後學藉此帖練習VBA,學習方案如下,請前輩參考,請各位前輩指教

執行前:


執行結果:



Option Explicit
Sub TEST()
Dim Brr, R&, j&, C%, N%
C = Cells(19, Columns.Count).End(xlToLeft).Column
R = Range([A1], ActiveSheet.UsedRange).Rows.Count
Brr = Range([A19], Cells(20, C))
For j = 1 To UBound(Brr, 2)
   If Trim(UCase(Brr(1, j))) <> Trim(UCase(Brr(2, j - N))) Then
      Cells(20, j - N).Resize(R - 19).Insert Shift:=xlToRight
      Cells(20, j - N) = Cells(19, j - N): N = N + 1
   End If
Next
Erase Brr
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
2#
發表於 2023-4-26 13:53 | 顯示全部帖子
回復 4# PJChen


    謝謝前輩,請參考此帖的學習方案忽略#6樓的學習方案
(因為#6樓只考慮到差1個欄位),後學搞錯邏輯

Option Explicit
Sub TEST()
Dim Brr, R&, j&, C%
C = Cells(19, Columns.Count).End(xlToLeft).Column
R = Range([A1], ActiveSheet.UsedRange).Rows.Count
i01:
Brr = Range([A19], Cells(20, C))
For j = 1 To UBound(Brr, 2)
   If Trim(UCase(Brr(1, j))) <> Trim(UCase(Brr(2, j))) Then
      Cells(20, j).Resize(R - 19).Insert Shift:=xlToRight
      Cells(20, j) = Cells(19, j): GoTo i01
   End If
Next
Erase Brr
End Sub
這應該有更適合的寫法,請各位前輩指教
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
3#
發表於 2023-4-27 08:41 | 顯示全部帖子
回復 8# PJChen


    謝謝前輩回復,謝謝論壇,謝謝各位前輩

1.這次的範例不一樣,情境不一樣,是多出欄位,後學認為應該要要求前流程提供檔案者要自律,提供正確的資料檔
2.因為前輩的實際使用檔通常會有公式,這次範例應該是要刪除兩欄中局部的儲存格
3.而且要考慮2刪除後會不會影響公式,請前輩自己試寫刪除多餘局部儲存格的VBA,有問題再提出

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

TOP

        靜思自在 : 一句溫暖的話，就像往別人身上灑香水，自己會沾到兩三滴。
返回列表 上一主題