如何将多个 excel 单元格与格式化组合

Question

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

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

在每个单元格上做下标是很多工作。 以前我发现了一个 VBA 代码来组合两个单元格（ 两个字符串的连接和上标）。

Answer 1

请尝试此代码。 它假定您的 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

Answer 2

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

Answer 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