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

我很抱歉,如果已经有同样的问题在其他地方问了一个答案,但我一直无法find它,所以我在这里。

我还会提到,我是一名VBA初学者,主要是从其他人获得的代码中获得我想要的代码。

我目前在AD列中有数据,列C中的信息是重要的列。 其他一切都应该被忽略。

Sheet1的单元格C1中有一行文本。 它是25个字符长,类似于以下内容:

4760-000004598700000000000

我有超过970,000行的数据,需要将这些单元格中的信息提取到另一个单元格中的两个不同的单元格中。

由于logging的数量,我不能简单地使用一个公式(当我尝试时,Excel崩溃)。

如果使用C1的中间函数,我会input类似(C1,2,3)和(C1,5,11)的东西。 (除了列C中的每个单元外)

+或 – 与第一个非零值的开头之间的前导零不会影响结果,但如果需要的话,我可以自行修复该部分。

理想情况下,信息将被拉到我已经准备好的A和B列的现有表格中。 (IE:Sheet2的)

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

A | B

760 | -0000045987 -45987

我已经研究了数组,分割和中间代码,但是我有麻烦,以我对VBA有限的知识来适应我的情况。 我相信有一种方法可以做到这一点,我将不胜感激任何帮助提出解决scheme。

预先感谢您的帮助,请让我知道如果您需要任何额外的信息。

这个怎么样:

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 

这听起来像你以后可以通过文本到列工具来实现。 我不知道你是否试图把它作为现有macros的一个步骤,或者如果这是你想要的macros,所以我会给你两个答案。

如果您只是想在指定的位置分割文本,则可以使用“文本到列”工具。 突出显示要修改的单元格,然后转到“数据”选项卡,然后从“数据工具”组中select“文本到列”。 在这里输入图像说明

在“文本到列”向导中,select“固定宽度”单选button,然后单击“下一步”。 在步骤2中,单击数据预览以在要分割数据的位置添加分隔符 – 因此,在上面给出的示例中,在“760”和“ – ”之间单击。 再次单击下一步。

在第3步中,您可以select操作产生的每个列的格式。 这对于您提到的前导零来说很有用 – 您可以将每列设置为“文本”。 准备就绪后,单击完成,数据将被拆分。

你可以用VBA做相同的事情,使用相当简单的代码,这些代码可以是独立的,也可以集成到一个更大的macros中。

 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 

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

我认为有一个数组公式可以做到这一点,但我更喜欢暴力方法。 有两种方法可以用一个过程或一个函数来填写字段。 我已经做了两个,为你说明他们。 另外,我还特意使用了很多参考单元格和分离文本的方法来说明实现目标的各种方法。

 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