- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-5-5
|
回復 7# 准提部林
謝謝論壇,謝謝前輩指導
後學以 前輩的方案改成以不同(函數,方法,語法....等)達到相同目的,學習到很多知識
學習方案如下,請前輩再指導
Option Explicit
Sub TEST_1()
Dim Brr, Crr, C, A, i&, R&, M&, j%, U%
[J:N].ClearContents
A = Split(Replace([I1], Left([I1], 1), "_" & Left([I1], 1)), "_")
U = UBound(A): If U = -1 Then Exit Sub
Brr = Range([F1], [B65536].End(3))
ReDim Crr(1 To UBound(Brr), 1 To U)
For j = 1 To U
C = Application.Match(A(j), [B1:H1], 0)
If IsError(C) Then Exit Sub Else R = 1
Crr(R, j) = Brr(1, 1) & "(" & A(j) & ")"
For i = 1 To UBound(Brr)
If Val(Brr(i, C)) > 0 Then
R = R + 1
Crr(R, j) = Brr(i, 1)
End If
Next
If R > M Then M = R
Next
If M > 0 Then [J1].Resize(M, U) = Crr
End Sub |
|
發表於 2023-11-16 13:58
| 
