如何将多个excel单元格与格式结合起来答案

【问题标题】：How to combine multiple excel cells with formatting如何将多个excel单元格与格式结合起来
【发布时间】：2021-04-03 11:30:22
【问题描述】：

我在 excel 中有 6 个单元格 A1 到 F1（如下所示）

如何连接所有六个单元格，但我的带有数字的单元格应该是下标。最后，我应该为每一行得到类似下面的内容。

在每个单元格上做下标需要做很多工作。以前我找到了一个 VBA 代码来组合两个单元格 (Concatenation of 2 strings and superscript)。

【问题讨论】：

那么你是如何开始编辑你找到的代码的呢？
是的。它对我有用，而且很完美。

标签： excel vba

【解决方案1】：

Option Explicit

Sub test()
    Call SubscriptIt(Range("A1:H9"))
End Sub

Sub SubscriptIt(rng As Range)

    Dim row As Range, cell As Range
    Dim col As New Collection, v, ar
    Dim i As Integer, s As String

    For Each row In rng.Rows
        Set col = Nothing
        s = ""
         
        ' determine position,length of numbers
        For Each cell In row.Cells
            If IsNumeric(cell) Then
               col.Add Len(s) & ":" & Len(cell)
            End If
            s = s & cell
        Next
    
        ' output in next column
        Set cell = row.Cells(1, rng.Columns.Count + 1)
        cell = s
        cell.Font.Subscript = False
      
        ' apply formatting
        For Each v In col
           ar = Split(v, ":")
           cell.Characters(ar(0) + 1, ar(1)).Font.Subscript = True
        Next
 
     Next
     MsgBox rng.Rows.Count & " rows updated"
End Sub

【讨论】：

【解决方案2】：

请尝试此代码。它假定您的 6 个单元格从 A 列开始，并将结果插入 G 列。

Sub CombineAndFormat()
    ' 212
    
    Dim Fun     As String           ' output string
    Dim Arr     As Variant          ' one row's data
    Dim Chars() As Integer          ' element length
    Dim n       As Integer          ' character count
    Dim i       As Long             ' loop counter: index
    Dim R       As Long             ' loop counter: rows
    
    Application.ScreenUpdating = False          ' speeds up execution
    With Worksheets("Sheet1")       ' change to suit
        ' loop through rows 2 to end of column A
        For R = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            Arr = .Range(.Cells(R, 1), .Cells(R, 6)).Value
            ReDim Chars(1 To UBound(Arr, 2))
            Fun = ""
            n = 0
            
            For i = 1 To UBound(Arr, 2)
                Chars(i) = Len(Arr(1, i))
                Fun = Fun & CStr(Arr(1, i))
            Next i
            
            With .Cells(R, 7)
                .Value = Fun
                With .Font                          ' this is the base font
    '                .Name = "Calibri"              ' specify to suit
    '                .FontStyle = "Regular"
                    .Size = 11
                    .Subscript = False
                End With
                For i = 1 To 6 Step 2
                    With .Characters(Start:=n + Chars(i) + 1, Length:=Chars(i + 1)).Font
                        ' this is the subscripted font:-
    '                    .Name = "Calibri"              ' specify to suit
    '                    .FontStyle = "Regular"
                        .Subscript = True
                    End With
                    n = n + Chars(i) + Chars(i + 1)
                Next i
            End With
        Next R
    End With
    Application.ScreenUpdating = True
End Sub

【讨论】：

嗨 Variatus，非常感谢。这是完美的。
@Prasad 我很高兴我的代码对你有用。请将其标记为“已选择”，以便它也适用于其他人。谢谢。

【解决方案3】：

Function Subscript()

'Define Variables
Dim A, B, C, D, E, F As String
Dim l_A, l_B, l_C, l_D, l_E, l_F As Integer

'Read the content of the cells in row 2
A = Worksheets("Sheet14").Cells(2, 1).Value
B = Worksheets("Sheet14").Cells(2, 2).Value
C = Worksheets("Sheet14").Cells(2, 3).Value
D = Worksheets("Sheet14").Cells(2, 4).Value
E = Worksheets("Sheet14").Cells(2, 5).Value
F = Worksheets("Sheet14").Cells(2, 6).Value

'Get the length of each string in the second row
l_A = Len(A)
l_B = Len(B)
l_C = Len(C)
l_D = Len(D)
l_E = Len(E)
l_F = Len(F)

'Write the content of all cells together in the second row in the column G
Worksheets("Sheet14").Cells(2, 7).Value = A & B & C & D & E & F
'Write the content of Cell B as Subscript in Column G
Worksheets("Sheet14").Cells(2, 7).Characters(l_A + 1, l_B).Font.Subscript = True
'Write the content of Cell D as Subscript in Column G
Worksheets("Sheet14").Cells(2, 7).Characters(l_A + l_B + l_C + 1, l_D).Font.Subscript = True
'Write the content of Cell F as Subscript in Column G
Worksheets("Sheet14").Cells(2, 7).Characters(l_A + l_B + l_C + l_D + l_E + 1, l_F).Font.Subscript = True

End Function

【讨论】：