修复了文本框VBA中的宽度列

Question

For Each cell In wb.Sheets("RP Analysis").Range("F5:F" & lastRow)
    structure = "Layer " & WorksheetFunction.RoundDown(cell.Value, 2) & ": " & WorksheetFunction.RoundDown(cell.Offset(0, 2).Value / 1000000, 2) & " xs " & WorksheetFunction.RoundDown(cell.Offset(0, 3).Value / 1000000, 2) & " attaches at "
    RMS = RMS & structure & WorksheetFunction.RoundDown(cell.Offset(0, 10).Value, 2) & "m and exhausts at " & WorksheetFunction.RoundDown(cell.Offset(0, 11).Value, 2) & "m" & vbLf
    AIR = AIR & structure & WorksheetFunction.RoundDown(cell.Offset(0, 6).Value, 2) & "m and exhausts at " & WorksheetFunction.RoundDown(cell.Offset(0, 7).Value, 2) & "m" & vbLf
Next cell

For Each cell In wb.Sheets("RP Analysis").Range("A9:A" & 19)
        gucurve = gucurve & cell.Value & ":-   " & Format(cell.Offset(0, 2).Value / cell.Offset(0, 1).Value, "Percent") & vbLf
Next cell

TextBox1.Value = "RP years    RMS/AIR difference" & vbLf & gucurve & vbLf & "AIR" & vbLf & AIR & vbLf & "RMS" & vbLf & RMS

这产生了

  Layer 1: 25 xs 50 attaches at 8.16m and exhausts at 10.4m
  Layer 2: 100 xs 75 attaches at 10.4m and exhausts at 20.15m
  Layer 3: 44 xs 175 attaches at 20.15m and exhausts at 24.96m
  Layer 4: 144 xs 175 attaches at 20.15m and exhausts at 34.86m

我想要它生产

  Layer 1: 25 xs  50 attaches at  8.16m and exhausts at  10.4m
  Layer 2:100 xs  75 attaches at  10.4m and exhausts at 20.15m
  Layer 3: 44 xs 175 attaches at 20.15m and exhausts at 24.96m
  Layer 4:144 xs 175 attaches at 20.15m and exhausts at 34.86m

所以我认为我需要具有定义宽度的固定列，其中所有内容都居中。 这些数字不会超过4位数

我该怎么做？

Answer 1

你可以使用带有@符号的Format来填充和对齐右边的每个值：

Format("123", "@@@@@@@@@@")     ' returns "       123"

或者在左边：

Format("123", "!@@@@@@@@@@")    ' returns "123       "

并通过提供字符数：

Format("123", String(25, "@"))  ' returns "                      123"

Answer 2

一种方法是创建自己的函数，返回固定长度的字符串。 下面的字符串和前缀需要尽可能多的空格来达到所需的长度。 超大字符串不会被修剪，但如果需要，这将是一个简单的更改。

Public Function Pad(ByVal OriginalString As String, ByVal RequiredLength As Integer) As String
' Prefixes the passed string with spaces, to return a fixed width string.

    ' Check padding required.
    If RequiredLength > Len(OriginalString) Then

        ' Required, prefix with spaces.
        Pad = Space(RequiredLength - Len(OriginalString)) & OriginalString
    Else

        ' Padding not required, return original value.
        Pad = OriginalString
    End If
End Function

您可以像这样调用此函数：

..."Layer " & Pad(WorksheetFunction.RoundDown(cell.Value, 2), 10) &...

编辑

@Michael发布了一个更整洁的方法。 我想用他的代码重写我的pad函数。 在一条线上; 现在，函数体更容易调试/跟踪。 我忘记了VBA 格式功能的灵活性。

Public Function Pad(ByVal OriginalString As String, ByVal RequiredLength As Integer) As String
' Prefixes the passed string with spaces, to return a fixed width string.

    Pad = Format(OriginalString, String(RequiredLength, "@"))
End Function

Answer 3

我发现维护列格式化的最简单代码就是用固定宽度字符串构建输出。 如果您使用=分配或使用LSet它们将默认为左对齐。 您可以使用RSet将它们对齐。 另请注意，如果您尝试分配的字符串长度超过其可容纳的长度，则会截断固定长度的字符串。

例：

Private Function ToColumns(layer As Long, percent As Long, xs As Long, attach As Double, _
                           exhaust As Double) As String
    Dim col1 As String * 1      'Change the widths here to adjust your columns.
    Dim col2 As String * 3
    Dim col3 As String * 3
    Dim col4 As String * 5
    Dim col5 As String * 5

    RSet col1 = layer
    RSet col2 = percent
    RSet col3 = xs
    RSet col4 = Format$(attach, "#.##")
    RSet col5 = Format$(exhaust, "#.##")

    ToColumns = "Layer " & col1 & ":" & _
                col2 & " xs " & _
                col3 & " attaches at " & _
                col4 & "m and exhausts at " & _
                col5 & "m"
End Function

用法：

Debug.Print ToColumns(1, 25, 50, 8.16, 10.4)
Debug.Print ToColumns(2, 100, 75, 10.4, 20.15)

输出：

Layer 1: 25 xs  50 attaches at  8.16m and exhausts at  10.4m
Layer 2:100 xs  75 attaches at  10.4m and exhausts at 20.15m

请注意，正如其他海报所述，如果您在UI中显示此内容，则需要使用等宽字体。

Answer 4

参考： Monospaced字体

您需要使用等宽字体，也称为固定间距，固定宽度或非比例字体，是一种字体和字符各自占据相同数量的水平空间的字体。 这与可变宽度字体形成对比，其中字母和间距具有不同的宽度。

参考： Microsoft提供的Monospaced TrueType字体

Microsoft提供的唯一等宽TrueType字体是Windows 3.1附带的Courier New和TrueType字体包中包含的Lucida Sans Typewriter。 Windows 3.1和TrueType字体包中包含的所有其他TrueType字体都是比例字体。