標題: [發問] 帶出非空白資料 [打印本頁]

---

作者: PJChen    時間: 2023-4-12 03:34     標題: 帶出非空白資料

前輩們好,

J:AC欄是箱號
J:AC欄若全空白,則AD欄=空白

請教前輩,AD欄要如何達成
帶出J:AC欄,所有非空白的資料,中間以","隔開
[attach]36118[/attach]

---

作者: Andy2483    時間: 2023-4-12 09:02

回復 1# PJChen


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

執行前:
[attach]36119[/attach]

執行結果:
[attach]36120[/attach]


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

---

作者: PJChen    時間: 2023-4-12 23:41

回復 2# Andy2483

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

---

作者: Andy2483    時間: 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

---

作者: Andy2483    時間: 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

---

作者: PJChen    時間: 2023-4-16 03:32

回復 5# Andy2483

感謝您的解說

---

作者: 准提部林    時間: 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

---

作者: Andy2483    時間: 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

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)