- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
回復 2# starbox520
妳的功力有增強了，加油！
以下兩個模組在使用陣列時，應用上有些許變化，
提供妳參考：- Sub Ex()
- Dim ln As Variant, ar As Variant
- Dim cts As Integer, ct2 As Integer
-
- With 工作表1
- ln = .[A1].CurrentRegion.Value
- ReDim ar(1 To UBound(ln, 2) - 1, 1 To 2)
- For cts = 1 To UBound(ln, 2) - 1
- ar(cts, 1) = ln(1, cts + 1)
- ar(cts, 2) = ""
- For ct2 = 3 To UBound(ln, 1)
- If ln(ct2, cts + 1) <> 0 Then
- ar(cts, 2) = IIf(ar(cts, 2) = "", ln(ct2, 1) & IIf(ln(ct2, cts + 1) > 0, "+", "") & ln(ct2, cts + 1), _
- ar(cts, 2) & "," & ln(ct2, 1) & IIf(ln(ct2, cts + 1) > 0, "+", "") & ln(ct2, cts + 1))
- End If
- Next ct2
- Next cts
- With 工作表2
- .UsedRange.ClearContents
- .[A1].Resize(UBound(ar, 1), UBound(ar, 2)) = ar
- End With
- End With
- End Sub
- Sub Ex1() ' ReDim Preserve 的應用；變更最後維度的大小時，用來保留現有陣列資料。
- Dim ln As Variant, ar As Variant
- Dim cts As Integer, ct2 As Integer
-
- With 工作表1
- ln = .[A1].CurrentRegion.Value
- ' UBound(Ln, 1) = 25 : Long / UBound(Ln, 2) : 8 : Long
- For cts = 1 To UBound(ln, 2) - 1
- If IsEmpty(ar) Then ReDim ar(1 To 2, 1 To 1) Else ReDim Preserve ar(1 To 2, 1 To UBound(ar, 2) + 1)
- ar(1, cts) = ln(1, cts + 1)
- ar(2, cts) = ""
- For ct2 = 3 To UBound(ln, 1)
- If ln(ct2, cts + 1) <> 0 Then
- ar(2, cts) = IIf(ar(2, cts) = "", ln(ct2, 1) & IIf(ln(ct2, cts + 1) > 0, "+", "") & ln(ct2, cts + 1), _
- ar(2, cts) & "," & ln(ct2, 1) & IIf(ln(ct2, cts + 1) > 0, "+", "") & ln(ct2, cts + 1))
- End If
- Next ct2
- Next cts
-
- With 工作表2
- .UsedRange.ClearContents
- .[A1].Resize(UBound(ar, 2), UBound(ar, 1)) = Application.Transpose(ar)
- End With
- End With
- End Sub
|
|
發表於 2016-12-10 10:57
| 
