Board logo

標題: 請問要如何把A1、A2、A3合併至 C1, 文字內容字型、顏色不變。 [打印本頁]
作者: oiggu    時間: 2011-10-27 14:19     標題: 請問要如何把A1、A2、A3合併至 C1, 文字內容字型、顏色不變。

各位好:
請問要如何把A1、A2、A3合併至 C1, 文字內容字型、顏色不變。
VBA 要如何編寫
SUB TEST()
[C1]=[A1]&[A2]&[A3]
END SUB
所顯示之結果只有字串之合併，顏色屬性皆改變。
[attach]8355[/attach]
作者: GBKEE    時間: 2011-10-27 16:05

回復 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    時間: 2011-10-27 21:46

回復 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    時間: 2011-10-28 08:09

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)