12
返回列表 上一主題 發帖

[發問] 資料複數回傳

s13983037

帖子
60 
主題
26 
精華
0 
積分
93 
點名
0  
作業系統
Windows 
軟體版本
Windows 7 
閱讀權限
20 
註冊時間
2014-9-8 
最後登錄
2020-4-15 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2018-7-12 01:33 | 只看該作者

[發問] 資料複數回傳

請問前輩們
有甚麼方法, 可行,
關於資料複數回傳

由於黃色區塊每一格都有函式，
黃色區塊有資料顯示時，　
則進行資料回傳，

由於黃色區塊顯示時，可能會有多筆或單單一筆資料
如果只有出現一筆資訊顯示，則顯示單一資訊
如果有複數以上資訊顯示，　則使用合併有出現的資料
顯示方法
由左至右進行比對

可透過一般函式進行嗎，　
想讓資訊進行即時更新．

如果是透過ＶＢＡ，　可能就無法即時更新了

以下為示意圖


附檔
EXCEL_問題.rar (9.4 KB)
收藏 分享

hcm19522

帖子
1796 
主題
184 
精華
0 
積分
1985 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
100 
性別
男 
註冊時間
2015-9-11 
最後登錄
2026-9-24 

熱烈參與勳章
16#
發表於 2018-8-23 10:02 | 只看該作者
http://blog.xuite.net/hcm19522/twblog/585214989
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
15#
發表於 2018-8-10 12:11 | 只看該作者
本帖最後由 准提部林 於 2018-8-10 12:13 編輯

回復 14# sun19860126


沒有檔案看，只能猜著寫∼∼
Sub fourFATNOcombine()
Dim Arr, Brr, Vrr, i&, j&, T$
Arr = Range(Cells(3, 146), Cells(2000, 245))　'第１４６欄至２４５欄範圍
Brr = Range(Cells(3, 2), Cells(2000, 2))　'第２欄（Ｂ欄）
ReDim Vrr(1 To UBound(Arr), 0)　'定義一個空陣列
For i = 1 To UBound(Arr)　
　　If Brr(i, 1) = "" Then GoTo 101　'如果Ｂ欄為空，略過此行
　　For j = 1 To UBound(Arr, 2)
　　　　If Arr(i, j) <> "" Then T = T & "/" & Arr(i, j)
　　Next j
　　Vrr(i, 0) = Mid(T, 2): T = ""
101: Next i
Cells(3, 9).Resize(UBound(Vrr)) = Vrr
End Sub

TOP

sun19860126

帖子
5 
主題
0 
精華
0 
積分
52 
點名
0  
作業系統
windows 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2015-11-14 
最後登錄
2022-11-30 
14#
發表於 2018-8-10 11:07 | 只看該作者
感謝樓上~我剛好有與發文者類似需求
所以就用同樣寫法再更改，只是欄位需求變大
Sub fourFATNOcombine()

' fourFATNOcombine 巨集
'
Dim Out As Variant
For n = 3 To 2000
If Cells(n, 2) <> "" Then
Out = Array(Cells(n, 146), Cells(n, 245))
***上面這一段我要從146欄吃資料到245欄，土法煉鋼似乎無法解
ub = UBound(Out)
For i = 0 To ub
If Out(i) <> "" Then: OutAll = OutAll & "/" &

Out(i)
Next
Cells(n, 9) = Mid(OutAll, 2, 999)
OutAll = ""
End If
Next

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
13#
發表於 2018-8-10 10:55 | 只看該作者
回復 12# sun19860126


將資料範圍放到自訂函數的公式中即可,
除非需求不同, 可上傳範例並加說明規則!

TOP

sun19860126

帖子
5 
主題
0 
精華
0 
積分
52 
點名
0  
作業系統
windows 7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
台北 
註冊時間
2015-11-14 
最後登錄
2022-11-30 
12#
發表於 2018-8-10 10:23 | 只看該作者
請問如果同樣狀態，欄位很多到100-200欄
要怎麼改會比較好? 謝謝大大

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
11#
發表於 2018-7-25 15:44 | 只看該作者
若只有那幾格??
=SUBSTITUTE(TRIM(C5&" "&D5&" "&E5&" "&F5&" "&G5&" "&H5&" "&I5&" "&J5&" "&K5)," ",",")

或用自訂函數
Function NumTxt(ARR) As String
Dim A, T$
For Each A In ARR
    T = Trim(T & " " & A)
Next
NumTxt = Replace(T, " ", ",")
End Function

公式:=NumTxt(C5:K5)

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
10#
發表於 2018-7-25 14:52 | 只看該作者
回復 9# s13983037
VBA自己定義函式，還是能即時更新
模組中輸入
  1. Public Function MyJoin(source As Range, delimiter As String, Optional ignoreEmpty = True) As String
  2.     For Each x In source
  3.         If Not ignoreEmpty Or Len(x) > 0 Then
  4.             MyJoin = MyJoin & IIf(Len(MyJoin) = 0, "", delimiter) & x.Text
  5.         End If
  6.     Next
  7. End Function
複製代碼
M5填入 =MyJoin(C5:K5, ",", TRUE)
第一個參數是結合的範圍，第二參數是要使用的分隔符號，第三參數是用來選擇是否要忽略空白。
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

s13983037

帖子
60 
主題
26 
精華
0 
積分
93 
點名
0  
作業系統
Windows 
軟體版本
Windows 7 
閱讀權限
20 
註冊時間
2014-9-8 
最後登錄
2020-4-15 
9#
發表於 2018-7-15 23:19 | 只看該作者
回復 8# faye59


    謝謝, 了解, 我在自己修改一下, 就差不多了
   感謝^^

TOP

faye59
　暱稱: 温奇
　頭銜: 議論者

中學生Rank: 2

帖子
104 
主題
5 
精華
0 
積分
110 
點名
0  
作業系統
win7 
軟體版本
Office2007 
閱讀權限
20 
性別
男 
註冊時間
2017-11-14 
最後登錄
2019-4-30 

論壇榮譽勳章論壇贊助勳章
8#
發表於 2018-7-15 23:04 | 只看該作者
回復 6# s13983037
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Intersect(Target, [B5:K14]) Is Nothing Then Exit Sub
  3.     ex
  4. End Sub
複製代碼
  1. Sub ex()
  2. Dim Out As Variant
  3. For n = 5 To 16
  4. Out = Array(Cells(n, 3), Cells(n, 4), Cells(n, 5), Cells(n, 6), Cells(n, 7), Cells(n, 8), Cells(n, 9), Cells(n, 10), Cells(n, 11))
  5. ub = UBound(Out)
  6. For i = 0 To ub
  7. If Out(i) <> "" Then: OutAll = OutAll & "." & Out(i)
  8. Next
  9. Cells(n, 13) = Mid(OutAll, 2, 99)
  10. OutAll = ""
  11. Next
  12. End Sub
複製代碼
一分努力，一分收穫。
發問題前可以先搜索內文是否有相關範例。

TOP

        靜思自在 : 屋寬不如心寬。
12
返回列表 上一主題