[發問] 帶出非空白資料

　暱稱: 厚臉皮的學生

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

8^#

發表於 2023-4-24 10:48 | 只看該作者

本帖最後由 Andy2483 於 2023-4-24 10:51 編輯

回復 7# 准提部林

謝謝論壇,謝謝前輩指導
後學學習心得註解如下,請前輩再指導

Option Explicit
Sub TEST_A1()
Dim Arr, T$, i&, j%
'↑宣告變數:Arr是通用型變數,T是字串變數,i是長整數,j是短整數
Arr = Range("J1:AC" & Cells(Rows.Count, 1).End(3).Row)
'↑令Arr這通用型變數是二維陣列,以[J1]到AC欄最後一個有內容儲存格值帶入
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2 到Arr陣列縱向最大索引列號
For j = 1 To UBound(Arr, 2)
'↑設順迴圈!j從1 到Arr陣列橫向最大索引欄號
      T = Trim(T & " " & Trim(Arr(i, j)))
      '↑令T這字串變數是 T變數連接空白字元,
      '再連接去頭尾空白字元的i迴圈列j迴圈欄Arr陣列值所組成的新字串
      '最後再去除頭尾的空白字元
Next j
Arr(i - 1, 1) = Replace(T, " ", ","): T = ""
'↑令(i變數-1)列第1欄Arr陣列值是 T變數將空白字元置換為逗號後的字串,
'令T變數是空字元,這樣的方式可以讓字串最前方與後方不會多一個逗號
Next i
With [ad2].Resize(UBound(Arr) - 1)
'↑以下是關於[AD2]儲存格擴展向下(Arr陣列縱向索引號-1)個儲存格的程序
   .NumberFormatLocal = "@"
   '↑令該區域儲存格格式是文字
   .Value = Arr
   '↑令該區域儲存格值以Arr陣列值帶入
End With
End Sub

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

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

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

7^#

發表於 2023-4-21 13:34 | 只看該作者

數據源應避免用程式覆蓋一次, 只列出結果位置即可~~
若資料多且欄位多, 整個重新貼上就會拖慢速度.

Sub TEST_A1()
Dim Arr, T$, i&, j%
Arr = Range("J1:AC" & Cells(Rows.Count, 1).End(3).Row)
For i = 2 To UBound(Arr)
For j = 1 To UBound(Arr, 2)
      T = Trim(T & " " & Trim(Arr(i, j)))
Next j
Arr(i - 1, 1) = Replace(T, " ", ","): T = ""
Next i
With [ad2].Resize(UBound(Arr) - 1)
   .NumberFormatLocal = "@"
   .Value = Arr
End With
End Sub

PJChen

　暱稱: PJ

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

6^#

發表於 2023-4-16 03:32 | 只看該作者

回復 5# Andy2483

感謝您的解說

　暱稱: 厚臉皮的學生

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

5^#

發表於 2023-4-14 08:22 | 只看該作者

回復 3# PJChen

再次謝謝前輩發表此主題,謝謝論壇
後學複習程式碼做心得註解,請前輩參考,請各位前輩指教

,Option Explicit
Sub TEST()
Dim Brr, i&, j&, T$, T1$, xR As Range, Sh As Worksheet
'↑宣告變數:Brr是通用型變數,(i,j)是長整數,(T,T1)是字串變數,
'xR是儲存格變數,Sh是工作表變數
Set Sh = Sheets("mark")
'↑令Sh這工作表變數是名為 "mark"的工作表
Set xR = Intersect(Sh.[J:AD], Sh.[J1].CurrentRegion.Offset(1, 0))
'↑令xR這儲存格變數是兩個範圍儲存格交集的範圍儲存格
'範圍1:"mark"工作表的J欄到AD欄之間的所有儲存格
'範圍2:"mark"工作表的[J1]儲存格相鄰串接儲存格擴展最小方正範圍的儲存格
Intersect(xR.Offset(1, 0), [AD:AD]).ClearContents
'↑令兩個範圍儲存格交集的範圍儲存格清除其內容
'範圍1:xR變數向下偏移一列的範圍儲存格
'範圍2:AD欄全部的儲存格
Brr = xR
'↑令Brr這通用型變數是二維陣列,令以xR變數值(儲存格值)帶入陣列
For i = 1 To UBound(Brr) - 1
'↑設順迴圈!i從 1到 Brr陣列縱向第2大索引列號
For j = 1 To UBound(Brr, 2) - 1
'↑設順迴圈!j從 1到 Brr陣列橫向第2大索引欄號
   T = Brr(i, j)
   '↑令T這字串變數是 i迴圈列第j迴圈欄的Brr陣列值
   T1 = Replace(Replace(T1 & "," & T & ",", ",,", ","), ",,", ",")
   '↑令T1這字串變數是 T1變數連接逗號,再連接T變數,
   '再連接逗號組成的新字串,最後經過兩次字串置換後的全新字串
   '第1次字串置換是將字串裡的",,"雙逗號置換成","1個逗號
   '第2次字串置換也是將字串裡的",,"雙逗號置換成","1個逗號
Next
Brr(i, 1) = Mid(Left(T1, Len(T1) - 1), 2): T1 = ""
'↑令i迴圈列第1欄Brr陣列值是斷捨離之後剩下的字串
'先T1變數字串取左側的字元,最右邊的字不取,
'之後再取右邊的字元,最左邊的字不取,
'PS:就是最左最右的這兩個字元不要,取中間的字串
Next
With Intersect(Intersect(xR, [AD:AD]), Sh.[J1].CurrentRegion)
'↑以下是關於兩次儲存格範圍交集後儲存格的程序
.Value = Brr: .Select
'↑令其儲存格值是 Brr陣列值,Brr陣列超過該儲存格範圍的值不用它
End With
Set xR = Nothing: Set Sh = Nothing: Erase Brr
'↑令釋放變數
End Sub

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

　暱稱: 厚臉皮的學生

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

4^#

發表於 2023-4-13 07:44 | 只看該作者

回復 3# PJChen

謝謝前輩回復
後學藉此帖在練習在同一陣列裡結果值蓋掉原陣列值,取出部分陣列值貼入目標格

Option Explicit
Sub TEST()
Dim Brr, i&, j&, T$, T1$, xR As Range, Sh As Worksheet
Set Sh = Sheets("mark")
Set xR = Intersect(Sh.[J:AD], Sh.[J1].CurrentRegion.Offset(1, 0))
Intersect(xR.Offset(1, 0), [AD:AD]).ClearContents
Brr = xR
For i = 1 To UBound(Brr) - 1
For j = 1 To UBound(Brr, 2) - 1
T = Brr(i, j)
T1 = Replace(Replace(T1 & "," & T & ",", ",,", ","), ",,", ",")
Next
Brr(i, 1) = Mid(Left(T1, Len(T1) - 1), 2): T1 = ""
Next
With Intersect(Intersect(xR, [AD:AD]), Sh.[J1].CurrentRegion)
.Value = Brr: .Select
End With
Set xR = Nothing: Set Sh = Nothing: Erase Brr
End Sub

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

PJChen

　暱稱: PJ

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

3^#

發表於 2023-4-12 23:41 | 只看該作者

回復 2# Andy2483

您好,
我上傳的檔案,為了使檔案不要肥大,所以把公式都值化了,執行程式後,很多公式都變成值,
您能否修改程式,不要將儲存格值化？
感謝您

　暱稱: 厚臉皮的學生

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

2^#

發表於 2023-4-12 09:02 | 只看該作者

回復 1# PJChen

謝謝論壇,謝謝各位前輩,謝謝前輩發表此主題與範例
後學藉此帖練習陣列,學習方案如下,請前輩參考

執行前:

執行結果:

Option Explicit
Sub TEST()
Dim Brr, i&, j&, T$, xR As Range, Sh As Worksheet
Set Sh = Sheets("mark")
Set xR = Intersect(Sh.[J:AD], Sh.[J1].CurrentRegion)
Intersect(xR.Offset(1, 0), [AD:AD]).ClearContents: Brr = xR
For i = 2 To UBound(Brr)
T = Brr(i, 21)
For j = 1 To UBound(Brr, 2) - 1
T = Replace(Replace(T & "," & Brr(i, j) & ",", ",,", ","), ",,", ",")
Next
Brr(i, 21) = Mid(Left(T, Len(T) - 1), 2)
Next
xR.NumberFormatLocal = "@": xR = Brr
Set xR = Nothing: Set Sh = Nothing: Erase Brr
End Sub

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