基于固定宽度的单元格中 MID/拆分文本的 Excel VBA 代码

Posted 2023-05-06

【中文标题】基于固定宽度的单元格中 MID/拆分文本的 Excel VBA 代码

【英文标题】：Excel VBA code for MID/Splitting text in cell based on fixed width

【发布时间】：2016-10-11 13:16:05

【问题描述】：

如果其他地方已经有人问过相同的问题并提供答案，我深表歉意，但是我找不到它，所以我开始了。

我还要提一下，我是一个 VBA 初学者，主要是玩弄从其他人那里获得的代码以获得我想要的东西。

我目前在 A-D 列中有数据，C 列中的信息是重要列。其他一切都应该忽略。

我在 sheet1 的单元格 C1 中有一行文本。它有 25 个字符长，类似于以下内容：

4760-000004598700000000000

我有超过 970,000 行数据，需要将在每个单元格中找到的信息提取到另一个工作表中的两个不同单元格中。

由于记录的数量，我不能简单地使用公式（我尝试时 Excel 崩溃）。

如果对 C1 使用 mid 函数，我会输入 (C1,2,3) 和 (C1,5,11) 之类的内容。 （除了 C 列中的每个单元格）

+ 或 - 之间的前导零和第一个非零值的开头无关紧要，但如果需要，我可以自行修复该部分。

理想情况下，信息会被提取到我准备好的现有工作表的 A 和 B 列中。 (IE:sheet2)

例如，使用上面提供的文本，工作表将如下所示：

A|B

760|-0000045987 或 -45987

我研究了数组、拆分和中间代码，但由于我对 VBA 的了解有限，我很难将它们适应我的情况。我确信有办法做到这一点，如果能提供解决方案，我将不胜感激。

提前感谢您的帮助，如果您需要任何其他信息，请告诉我。

【问题讨论】：

欢迎访问该网站 - 很高兴看到您已经阅读了该指南！ :) 请edit your question 显示您尝试过的“数组、拆分和中间代码”，您想要实现什么，以及发生了什么。如果发生的是编译或运行时错误，那很好——人们将能够更好地帮助您解决更具体的问题。

Excel 肯定会崩溃吗？如果您通过 VBA 中的循环执行此操作，则迭代 970k 行将花费相当长的时间，并且可能看起来也有一段时间没有响应。您是否尝试过在手动复制公式时将其计算为手动，然后再将其转回自动/计算？

@cxw 不幸的是，我不再拥有以前尝试过的代码，因为我不认为将它们保存以供将来参考，并且不记得收到的具体错误，但会记住这一点以备不时之需。

@TimEdwards 它肯定会崩溃。我等了将近一个小时，看它是否能完成任务无济于事。事实上，即使是一个小时，在那个时间段内对我也没有用处......

【参考方案1】：

听起来您所追求的可以通过“文本到列”工具来实现。我不确定您是否尝试将此作为现有宏中的一个步骤包含在内，或者这是否是您希望宏执行的全部操作，所以我会给您两个答案。

如果您只是想在指定点拆分文本，您可以使用文本分列工具。突出显示要修改的单元格，然后转到“数据”选项卡并从“数据工具”组中选择“文本到列”。

在“文本到列”向导中，选择“固定宽度”单选按钮，然后单击“下一步”。在第 2 步中，单击数据预览以在要拆分数据的位置添加中断 - 因此，在您上面给出的示例中，单击“760”和“-”之间。再次点击下一步。

在第 3 步中，您可以选择操作所产生的每一列的格式。这对于您提到的前导零很有用 - 您可以将每一列设置为“文本”。准备好后，点击完成，数据将被拆分。

您可以使用相当简单的代码对 VBA 执行相同的操作，这些代码可以是独立的，也可以集成到更大的宏中。

Sub RunTextToColumns()
    Dim rngAll As Range

    Set rngAll = Range("A1", "A970000")
    rngAll.TextToColumns _
        DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(3, 2))

    With Sheets("Sheet4").Range("A1", "A970000")
        .Value = Range("A1", "A970000").Value
        .Offset(0, 1).Value = Range("B1", "B970000").Value
    End With
End Sub

这需要大约一秒钟的时间来运行，包括拆分和复制数据。当然，对范围和工作表的硬编码引用是不好的做法，应该用变量或常量替换，但为了清楚起见，我保留了它。

【讨论】：

问题是，虽然我知道如何使用“文本到列”工具，但其他使用此工作簿的人却不知道，这实际上是我从事此工作的部分原因。您的代码可以工作，但是它将信息与文本放在同一张纸中，而我需要将它放在另一张纸中。 （表 2）

文本到列仍然是进行实际拆分的最快方法。之后，您可以添加一些代码将结果值移动到 Sheet2。我将进行编辑以反映这一点。

我很抱歉，因为我之前的评论有误。代码并没有完全按照我的需要做。在 Sheet1 的 A、B 和 D 列中，我有其他不需要提取的信息（我将使用此信息更新我的问题）。目前，它从 Sheet1 的 A 列（而不是 C 列）获取前三个字符，并将其放入 Sheet2 的 A 列。然后它将剩余的字符放在 Sheet2 的 B 列中。

【参考方案2】：

这个怎么样：

Sub GetNumbers()
Dim Cel As Range, Rng As Range, sCode As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set Rng = Sheets("Sheet1").Range("C1:C" & Sheets("Sheet1").Range("C1048576").End(xlUp).Row)

For Each Cel In Rng
    Sheets("Sheet2").Cells(Cel.Row, 1).Value = Mid(Cel.Value, 2, 3)
    sCode = Mid(Cel.Value, 5, 11)
    'Internale loop to get rid of the Zeros, reducing one-by-one
    Do Until Mid(sCode, 2, 1) <> "0" And Mid(sCode, 2, 1) <> 0
        sCode = Left(sCode, 1) & Right(sCode, Len(sCode) - 2)
    Loop
    Sheets("Sheet2").Cells(Cel.Row, 2).Value = sCode
Next

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

【讨论】：

它成功地分离了我需要的第二个值（11 位值）并删除了零。但是它将它放在新工作表的 A 列中，并且我需要的第一个值没有显示出来。

@Kyle 我的错 - 它已被修复！

完美！非常感谢您的帮助！！

【参考方案3】：

我认为有一个数组公式可以做到这一点，但我更喜欢蛮力方法。有两种方法可以填写字段，使用过程或使用函数。我已经做了两个，为你说明它们。此外，我特意使用了多种引用单元格和分隔文本的方法，以说明实现目标的各种方法。

Sub SetFields()
Dim rowcounter As Long, lastrow As Long
lastrow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row 'get the last row in column "C"

For rowcounter = 1 To lastrow 'for each row in the range of values
    'put the left part in column "D"
    ActiveSheet.Range("D" & rowcounter) = FieldSplitter(ActiveSheet.Cells(rowcounter, 3).Text, True)
    'and the right part in the column two over from colum "C"
    ActiveSheet.Cells(rowcounter, 3).Offset(0, 2) = FieldSplitter(ActiveSheet.Cells(rowcounter, 3).Text, False)
Next rowcounter
End Sub
Function FieldSplitter(FieldText As String, boolLeft As Boolean) As String
If boolLeft Then
    FieldSplitter = Mid(FieldText, 2, 3) 'one way of getting text from a string
Else
    FieldSplitter = Left(Right(FieldText, 16), 5) ' another way
End If
  'Another useful function is Split, as in myString = Split (fieldtext, "-")(0) This would return "4760"

End Function