返回列表 上一主題 發帖

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

oiggu

帖子
11 
主題
4 
精華
0 
積分
23 
點名
0  
作業系統
xp 
軟體版本
sp2 
閱讀權限
10 
性別
男 
來自
u 
註冊時間
2010-5-18 
最後登錄
2024-8-7 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2011-10-27 14:19 | 只看該作者

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

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

oiggu

帖子
11 
主題
4 
精華
0 
積分
23 
點名
0  
作業系統
xp 
軟體版本
sp2 
閱讀權限
10 
性別
男 
來自
u 
註冊時間
2010-5-18 
最後登錄
2024-8-7 
4#
發表於 2011-10-28 08:09 | 只看該作者
謝謝 GBKEE、 luhpro 功力太強了，經測試都可使用。
oiggu

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
15  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-12 
3#
發表於 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
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 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
複製代碼

TOP

        靜思自在 : 話多不如話少，話少不如話好。
返回列表 上一主題