Question

我需要完成以下任务：

before

变为

after

基本上在数字标题之间插入空格（1.0,1.1,1.2，插入空格，如果还不存在......）

如果数字不存在，请将其添加。（如'之前'图片2.0和6.0缺失）

我想出了如何创建一个数组来检查数据，如下所示：

Dim myRange As Range, c As Range
Dim x As Integer, i As Integer, arSize As Integer, y As Integer
Dim myArray() As String
x = 1
arSize = Int(Range("B" & Rows.Count).End(xlUp).Row)
ReDim myArray(1 To arSize)
Set myRange = Range("B1", Cells(Rows.Count, "B").End(xlUp))
For Each c In myRange
    If IsEmpty(c) = True Then
    myArray(x) = 0
    Else
        If IsNumeric(Left(c, 1)) = True Then
            myArray(x) = Val(Left(c, 1))
        Else: myArray(x) = -1
        End If
    End If
x = x + 1
Next
'for debugging:
For i = 1 To UBound(myArray)
    Range("F" & i).Value = myArray(i)
    Next i
End Sub

（如果第一个字符是数字，则将数字添加到数组元素;如果它不是数字，则将元素设置为-1，如果它为空，则将元素设置为0）

只需要一些建议或者我是如何操纵数据来实现我的目标的一个例子。非常感谢你。任何帮助表示赞赏。

Answer 1

您的想法在数据管理/设计方面似乎或多或少都很清楚，尽管您为此特定问题选择的方法对我来说似乎并不理想。我宁愿依赖Excel单元而不是数组（能够存储更多信息，易于复制，并且具有与您可以关联的目标格式相同的结构）。至于解释所有必需的更改并不容易，我更倾向于写下一个算法来执行你想要的动作（具有讽刺意味的是，在不久前批评了这个过程之后:)）。请记住，此代码依赖于“临时列”（默认情况下为C）来存储所有更改，这些更改将在整个过程完成后清除。请随时询问任何不清楚的内容（我发布这个内容供您理解所有内容，而不仅仅是执行它。）

Dim col2 As String: col2 = "C"
Dim firstRow As Integer: firstRow = 2
Set myRange = Range("B" & firstRow, Cells(Rows.Count, "B").End(xlUp))
Dim prevIndex As Integer: prevIndex = 1
Dim curRow As Long: curRow = firstRow - 1
For Each c In myRange
    curRow = curRow + 1
    Dim consecutive As Integer: consecutive = 0
    If Not IsEmpty(c) Then
        Dim written As Boolean: written = False
        Dim numRightBefore As Boolean: numRightBefore = False
        If IsNumeric(Left(c, 1)) = True Then
            Dim curIndex As Integer: curIndex = CInt(Left(c, 1))
            If (curIndex <> prevIndex) Then
               If (curIndex < prevIndex) Then
                   'Something went wrong
                   Exit For
               Else
                  If (curIndex = prevIndex + 1) Then
                      'Normal situation -> consecutive index
                      prevIndex = curIndex
                      If (consecutive <> 0) Then
                          Range(col2 & curRow).Value = ""
                          curRow = curRow + 1
                      End If
                  Else
                     Do While (curIndex > prevIndex + 1)
                        If (consecutive = 0) Then
                            Range(col2 & curRow).Value = ""
                            consecutive = 1
                         Else
                            curRow = curRow + 1
                         End If
                         prevIndex = prevIndex + 1
                         Range(col2 & curRow).Value = CStr(prevIndex) & ".0 text"
                         curRow = curRow + 1
                     Loop
                      prevIndex = prevIndex + 1
                      Range(col2 & curRow).Value = ""
                      curRow = curRow + 1
                  End If
               End If
            End If
        End If

        If (Not written) Then
            Range(col2 & curRow).Value = c.Value
        End If
        consecutive = curIndex
    End If
Next


Range(col2 & firstRow & ":" & col2 & curRow).Copy
myRange.PasteSpecial
Range(col2 & firstRow & ":" & col2 & curRow).Clear

注意：不建议创建太大的数组。确切的限制取决于计算机的功率（其内存）和当前条件（正在运行的其他程序）。还应该注意的是，过去我确实遇到过VBA和大阵列的一些问题，因此我更喜欢在这里更加谨慎。通常（在任何编程语言中），我很少声明大小高于5000的一维数组。

注意2：从性能的角度来看，读取/写入Excel单元格是一种非常糟糕的方法。 我不建议一般依赖此（默认情况下不是这样）。我认为在这些特定条件下这是一个好主意：输入数据的大小不清楚，并描绘了OP可能容易与之相关的方法。我个人会依赖数组和超过一定大小的临时文件（比从Excel读取/写入快得多）。

Answer 2

Sub tgr()

    Dim arrLines() As String
    Dim varLine As Variant
    Dim varLineStart As Variant
    Dim LineIndex As Long
    Dim lCounter As Long
    Dim lInterval As Long

    lCounter = 1
    lInterval = 5000
    ReDim arrLines(1 To lInterval)

    For Each varLine In Range("B2", Cells(Rows.Count, "B").End(xlUp)).Value
        LineIndex = LineIndex + 1
        varLineStart = Trim(Left(Replace(Trim(varLine), " ", String(99, " ")), 99))
        If IsNumeric(varLineStart) Then
            varLineStart = Int(varLineStart)
            If varLineStart > lCounter Then
                lCounter = lCounter + 1
                Do While varLineStart > lCounter
                    If Len(arrLines(LineIndex - 1)) = 0 Then
                        If LineIndex > UBound(arrLines) Then ReDim Preserve arrLines(1 To UBound(arrLines) + lInterval)
                        arrLines(LineIndex) = lCounter & ".0 text"
                        lCounter = lCounter + 1
                        LineIndex = LineIndex + 1
                    End If
                    LineIndex = LineIndex + 1
                Loop
                If Len(arrLines(LineIndex - 1)) > 0 Then LineIndex = LineIndex + 1
            End If
        End If
        If LineIndex > UBound(arrLines) Then ReDim Preserve arrLines(1 To UBound(arrLines) + lInterval)
        arrLines(LineIndex) = varLine
    Next varLine

    If LineIndex > 1 Then
        ReDim Preserve arrLines(1 To LineIndex)
        Range("C2").Resize(LineIndex).Value = Application.Transpose(arrLines)
    End If

    Erase arrLines

End Sub

Answer 3

这是我的宏版本供参考。我在case select中引用了命名常量。

Sub varocarbas()
Dim col2 As String: col2 = "C"
Dim firstRow As Integer: firstRow = 2
Set myRange = Range("B" & firstRow, Cells(Rows.Count, "B").End(xlUp))
Dim prevIndex As Integer: prevIndex = 1
Dim curRow As Long: curRow = firstRow - 1
For Each c In myRange
    curRow = curRow + 1


  Dim consecutive As Integer: consecutive = 0
    If Not IsEmpty(c) Then
        Dim written As Boolean: written = False
        Dim numRightBefore As Boolean: numRightBefore = False
        If IsNumeric(Left(c, 1)) = True Then
            Dim curIndex As Integer: curIndex = CInt(Left(c, 1))
            If (curIndex <> prevIndex) Then
               If (curIndex < prevIndex) Then
                   'Something went wrong
                   Exit For
               Else
                  If (curIndex = prevIndex + 1) Then
                      'Normal situation -> consecutive index
                      prevIndex = curIndex
                      If (consecutive <> 0) Then
                          Range(col2 & curRow).Value = ""
                          curRow = curRow + 1
                      End If
                  Else
                     Do While (curIndex > prevIndex + 1)
                        If (consecutive = 0) Then
                            Range(col2 & curRow).Value = ""
                            consecutive = 1
                         Else
                            curRow = curRow + 1
                         End If
                         prevIndex = prevIndex + 1
                            Dim sHeading As String
                         Select Case prevIndex
                            Case 1
                                sHeading = cIN
                            Case 2
                                sHeading = cTL
                            Case 3
                                sHeading = cPP
                            Case 4
                                sHeading = cRF
                            Case 5
                                sHeading = cPL
                            Case 6
                                sHeading = cPM
                            Case 7
                                sHeading = cPR
                            Case 8
                                sHeading = cRS
                            Case 9
                                sHeading = cCP
                            End Select
                         Range(col2 & curRow).Value = CStr(prevIndex) & ".0 " & sHeading
                         curRow = curRow + 1
                     Loop
                      prevIndex = prevIndex + 1
                      Range(col2 & curRow).Value = ""
                      curRow = curRow + 1
                  End If
               End If
            End If
        End If

        If (Not written) Then
            Range(col2 & curRow).Value = c.Value
        End If
        consecutive = curIndex
    End If
Next


Range(col2 & firstRow & ":" & col2 & curRow).Copy
myRange.PasteSpecial
Range(col2 & firstRow & ":" & col2 & curRow).Clear
End Sub

我应该如何使用vba完成这个复杂的字符串替换？

3 个答案: