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 format function的灵活性。

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 font

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

参考：Microsoft-Supplied Monospaced TrueType Fonts

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

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

4 个答案: