請問要如何把A1、A2、A3合併至 C1, 文字內容字型、顏色不變。

oiggu

各位好:
請問要如何把A1、A2、A3合併至 C1, 文字內容字型、顏色不變。
VBA 要如何編寫
SUB TEST()
[C1]=[A1]&[A2]&[A3]
END SUB
所顯示之結果只有字串之合併，顏色屬性皆改變。

下載 (28.31 KB)

2011-10-27 14:13

GBKEE

回復 1# oiggu

1. Sub Ex()
   
2.     Dim R As Range, i As Integer, ii As Integer
   
3.     [C1].Clear
   
4.     [C1] = Join(Application.WorksheetFunction.Transpose([A1:A3]), Chr(10))
   
5.     i = 1
   
6.     For Each R In [A1:A3]
   
7.         For ii = 1 To Len(R)
   
8.             With R.Characters(Start:=ii, Length:=1).Font
   
9.                 [C1].Characters(Start:=i, Length:=1).Font.Name = .Name
   
10.                 [C1].Characters(Start:=i, Length:=1).Font.FontStyle = .FontStyle
    
11.                 [C1].Characters(Start:=i, Length:=1).Font.Size = .Size
    
12.                 [C1].Characters(Start:=i, Length:=1).Font.Strikethrough = .Strikethrough
    
13.                 [C1].Characters(Start:=i, Length:=1).Font.Superscript = .Superscript
    
14.                 [C1].Characters(Start:=i, Length:=1).Font.Subscript = .Subscript
    
15.                 [C1].Characters(Start:=i, Length:=1).Font.OutlineFont = .OutlineFont
    
16.                 [C1].Characters(Start:=i, Length:=1).Font.Shadow = .Shadow
    
17.                 [C1].Characters(Start:=i, Length:=1).Font.Underline = .Underline
    
18.                 [C1].Characters(Start:=i, Length:=1).Font.ColorIndex = .ColorIndex
    
19.             End With
    
20.             i = i + 1
    
21.         Next
    
22.         i = i + 1
    
23.     Next
    
24. End Sub

複製代碼

luhpro

回復 2# GBKEE
也可以簡化成以下這樣 :

1. Sub Ex()
   
2.     Dim R As Range, i As Integer, ii As Integer
   
3.     Dim fS As Font, fT As Font
   
4.     [C1].Clear
   
5.     [C1] = Join(Application.WorksheetFunction.Transpose([A1:A3]), Chr(10))
   
6.     i = 1
   
7.     For Each R In [A1:A3]
   
8.         For ii = 1 To Len(R)
   
9.             Set fS = R.Characters(Start:=ii, Length:=1).Font
   
10.             Set fT = [C1].Characters(Start:=i, Length:=1).Font
    
11.             With fS
    
12.                 fT.Name = .Name
    
13.                 fT.FontStyle = .FontStyle
    
14.                 fT.Size = .Size
    
15.                 fT.Strikethrough = .Strikethrough
    
16.                 fT.Superscript = .Superscript
    
17.                 fT.Subscript = .Subscript
    
18.                 fT.OutlineFont = .OutlineFont
    
19.                 fT.Shadow = .Shadow
    
20.                 fT.Underline = .Underline
    
21.                 fT.ColorIndex = .ColorIndex
    
22.             End With
    
23.             i = i + 1
    
24.         Next
    
25.         i = i + 1
    
26.     Next
    
27. End Sub

複製代碼

oiggu

謝謝 GBKEE、 luhpro 功力太強了，經測試都可使用。