- ©«¤l
- 2035
- ¥DÃD
- 24
- ºëµØ
- 0
- ¿n¤À
- 2031
- ÂI¦W
- 0
- §@·~¨t²Î
- Win7
- ³nÅ骩¥»
- Office2010
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-3-22
- ³Ì«áµn¿ý
- 2024-2-1
|
¦^´_ 2# starbox520
©pªº¥\¤O¦³¼W±j¤F¡A¥[ªo¡I
¥H¤U¨âÓ¼Ò²Õ¦b¨Ï¥Î°}¦C®É¡AÀ³¥Î¤W¦³¨Ç³\ÅܤơA
´£¨Ñ©p°Ñ¦Ò¡G- Sub Ex()
- Dim ln As Variant, ar As Variant
- Dim cts As Integer, ct2 As Integer
-
- With ¤u§@ªí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 ¤u§@ªí2
- .UsedRange.ClearContents
- .[A1].Resize(UBound(ar, 1), UBound(ar, 2)) = ar
- End With
- End With
- End Sub
½Æ»s¥N½X- Sub Ex1() ' ReDim Preserve ªºÀ³¥Î¡FÅܧó³Ì«áºû«×ªº¤j¤p®É¡A¥Î¨Ó«O¯d²{¦³°}¦C¸ê®Æ¡C
- Dim ln As Variant, ar As Variant
- Dim cts As Integer, ct2 As Integer
-
- With ¤u§@ªí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 ¤u§@ªí2
- .UsedRange.ClearContents
- .[A1].Resize(UBound(ar, 2), UBound(ar, 1)) = Application.Transpose(ar)
- End With
- End With
- End Sub
½Æ»s¥N½X |
|