在Excel中将文本单元格拆分为70个字符块

我有一个Excel文件，其中一个单元格包含记录的键，另一个单元格包含键的文本；信息来自SQL Server数据库

文本单元格包括换行符和空行，我需要根据需要将此单元格的内容拆分为多达70个字符的行。对于每一行，我需要使用相同的键值以及“行序列”编号。关于文本，我需要保留整个单词，并尊重原始单元格中的白线和换行符

下面是其中一个单元格的示例（A1为关键单元格，A2为文本单元格）：

A1
ANUAL-LCD-FIX#0
A2
1-Limpieza general.
2-todo el Equipmo Tornileria的修订版，适用于必要的设备。
3-松树修订版，无埃斯滕·达纳多斯修订版，内切萨里奥再版（修订版）。
4-pantalla修订版，功能和功能均不受欢迎

分裂之后，这就是我需要得到的；请注意，需要创建3列（A、B和C）和6行（1..6）：

A1
ANUAL-LCD-FIX#0
B1
01
C1
1-Limpieza general.
A2
ANUAL-LCD-FIX#0
B2
02
C2
2-todo el Equipmo tornilleria的修订版，适用于服务
A3
ANUAL-LCD-FIX#0
B3
03
C3
必要的。
A4
ANUAL-LCD-FIX#0
B4
04
C4
3-松树的修订版，没有埃斯滕·达纳多斯的修订版，再就业的修订版
A5
ANUAL-LCD-FIX#0
B5
05
C5
necesario（修订工程设计协议）。
A6
ANUAL-LCD-FIX#0
B6
06
C6
4-pantalla修订版，功能和功能均不受欢迎

我在网上找到了一些分割单元格的例子，但是被分割单元格的长度是预先确定的，并且没有白线或换行符；在我的例子中，其中一些单元格少于70个字符，而其他单元格则长得多，因此很难提前知道拆分每个文本单元格需要多少行

谁能建议我如何做到这一点？如果需要更多信息或细节，请告诉我

谢谢。

请尝试以下代码：

Sub SubNewList()
    
    'Declarations.
    Dim IntCharacterLimit As Integer
    Dim IntCounter01 As Integer
    Dim IntCounter02 As Integer
    Dim IntMarkerPart As Integer
    Dim DblTextOffsetFromKey As Double
    Dim RngDestination As Range
    Dim RngKeyList As Range
    Dim RngTarget As Range
    Dim StrMarker01 As String
    Dim StrMarker02 As String
    Dim StrTextWhole As String
    Dim StrTextPart01 As String
    Dim StrTextPart02 As String
    Dim WksNewSheet As Worksheet
    
    'Setting variables.
    Set RngKeyList = Sheets("Sheet1").Range("A2")
    DblTextOffsetFromKey = 1
    StrMarker01 = Chr(10)
    StrMarker02 = " "
    IntCharacterLimit = 70
    
    'Changing RngKeyList to cover the whole list.
    Set RngKeyList = RngKeyList.Parent.Range(RngKeyList, RngKeyList.End(xlDown))
    
    'Creating a new sheet.
    Set WksNewSheet = Sheets.Add(After:=RngKeyList.Parent)
    
    'Setting RngDestination in the new sheet.
    Set RngDestination = WksNewSheet.Cells(1, 1)
    
    'Creating headers.
    RngDestination.Value = "Key"
    RngDestination.Offset(0, 1).Value = "Seq"
    RngDestination.Offset(0, 2).Value = "Text"
    Set RngDestination = RngDestination.Offset(1, 0)
    
    'Covering each cell in RngKeyList.
    For Each RngTarget In RngKeyList
        
        'If the given cell is empty, the subroutine is terminated.
        If RngTarget.Value = "" Then Exit Sub
        
        'Setting variable.
        IntCounter01 = 0
        
        'Coping the Text value in StrTextWhole.
        StrTextWhole = RngTarget.Offset(0, DblTextOffsetFromKey).Value
        
        'Covering each part of StrTextWhole delimited by StrMarker01.
        For IntMarkerPart = 0 To UBound(VBA.Strings.Split(StrTextWhole, StrMarker01))
            
            'Checking if the given part is not blank.
            If VBA.Strings.Split(StrTextWhole, StrMarker01)(IntMarkerPart) <> "" Then
                
                'Checking if the lenght of the given part exceed IntCharacterLimit.
                If Len(VBA.Strings.Split(StrTextWhole, StrMarker01)(IntMarkerPart)) <= IntCharacterLimit Then
                    
                    'Reporting the Key value.
                    RngDestination.Offset(IntCounter01, 0).Value = RngTarget.Value
                    
                    'Reporting the Seq value.
                    RngDestination.Offset(IntCounter01, 1).Value = IntCounter01 + 1
                    
                    'Reporting the Text value.
                    RngDestination.Offset(IntCounter01, 2).Value = VBA.Strings.Split(StrTextWhole, StrMarker01)(IntMarkerPart)
                    
                    'Setting IntCounter01 for the new row.
                    IntCounter01 = IntCounter01 + 1
                    
                Else
                    
                    'Coping the given part of StrTextWhole (delimited by StrMarker01) in StrTextPart01.
                    StrTextPart01 = VBA.Strings.Split(StrTextWhole, StrMarker01)(IntMarkerPart)
                    
                    Do
                        
                        'Reporting the Key value.
                        RngDestination.Offset(IntCounter01, 0).Value = RngTarget.Value
                        
                        'Reporting the Seq value.
                        RngDestination.Offset(IntCounter01, 1).Value = IntCounter01 + 1
                        
                        'Setting variables.
                        IntCounter02 = 0
                        StrTextPart02 = ""
                        
                        'In the Do-Loop cycle: coping in StrTextPart02 every remaining part of StrTextPart01 delimited
                        'by StrMarker02 as long as StrTextPart02 lenght is less then IntCharacterLimit
                        Do
                            
                            'Checking StrTextPart02 is blank.
                            If StrTextPart02 = "" Then
                                StrTextPart02 = VBA.Strings.Split(StrTextPart01, StrMarker02)(IntCounter02)
                            Else
                                StrTextPart02 = StrTextPart02 & StrMarker02 & VBA.Strings.Split(StrTextPart01, StrMarker02)(IntCounter02)
                            End If
                            
                            'Setting IntCounter02 for the next part (delimited by StrMarker02) in StrTextPart01.
                            IntCounter02 = IntCounter02 + 1
                            
                            'Checking if all of StrTextPart01 has been covered.
                            If IntCounter02 > UBound(VBA.Strings.Split(StrTextPart01, StrMarker02)) Then Exit Do
                        
                        Loop Until Len(StrTextPart02 & StrMarker02 & VBA.Strings.Split(StrTextPart01, StrMarker02)(IntCounter02)) > IntCharacterLimit
                        
                        'Reporting the Text value.
                        RngDestination.Offset(IntCounter01, 2).Value = StrTextPart02
                        
                        'Setting IntCounter01 for the next row.
                        IntCounter01 = IntCounter01 + 1
                        
                        'Checking if all of StrTextPart01 has been covered.
                        If Len(StrTextPart01) - Len(StrTextPart02) - 1 <= 0 Then Exit Do
                        
                        'Cutting the part already covered of StrTextPart01.
                        StrTextPart01 = Right(StrTextPart01, Len(StrTextPart01) - Len(StrTextPart02))
                        
                    Loop
                End If
            End If
        Next
        
        'Setting RngDestination for the next RngTarget.
        Set RngDestination = WksNewSheet.Cells(1, 1).End(xlDown).Offset(1, 0)
        
    Next
    
End Sub

子子网列表（）
"声明,。
Dim IntCharacterLimit为整数
Dim IntCounter01作为整数
Dim IntCounter02作为整数
作为整数的Dim INTMAKERPART
Dim DblTextOffsetFromKey为双精度
Dim RngDestination As范围
Dim RngKeyList As范围
变光目标As范围
作为字符串的Dim StrMarker01
作为字符串的Dim StrMarker02
将STRTEXT整体设置为字符串
作为字符串的Dim StrTextPart01
作为字符串的Dim StrTextPart02
将工作表变暗为工作表
'设置变量。
设置RngKeyList=图纸（“图纸1”）。范围（“A2”）
DblTextOffsetFromKey=1
StrMarker01=Chr（10）
StrMarker02=“”
IntCharacterLimit=70
'更改RngKeyList以覆盖整个列表。
设置RngKeyList=RngKeyList.Parent.Range（RngKeyList，RngKeyList.End（xlDown））
'创建新工作表。
设置WksNewSheet=Sheets.Add（后面：=RngKeyList.Parent）
'在新工作表中设置RngDestination。
设置RngDestination=WksNewSheet.Cells（1,1）
'创建标题。
RngDestination.Value=“Key”
RNGDestimation.Offset（0，1）.Value=“Seq”
RngDestination.Offset（0,2）.Value=“文本”
设置RngDestination=RngDestination.Offset（1,0）
'覆盖RngKeyList中的每个单元格。
对于RngKeyList中的每个RNG目标
'如果给定单元格为空，则子例程终止。
如果RngTarget.Value=“”，则退出Sub
'设置变量。
INT01=0
'在StrTextWhole中处理文本值。
StrTextWhole=RngTarget.Offset（0，DblTextOffsetFromKey）.Value
'覆盖由StrMarker01分隔的StrTextWhole的每个部分。
对于IntMarkerPart=0到UBound（VBA.Strings.Split（StrTextWhole，StrMarker01））
'检查给定零件是否为空。
如果VBA.Strings.Split（strtextfall，StrMarker01）（IntMarkerPart）“，则
'检查给定零件的长度是否超过IntCharacterLimit。
如果Len（VBA.Strings.Split（StrTextWhole，StrMarker01）（IntMarkerPart））您可以使用powerquery执行此操作


数据/获取和转换/来自表/范围
拆分为换行符上的行
使用自定义函数添加列以在空格前最多第70个字符进行拆分
展开拆分的列

M代码

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],

    //split by linefeed into new rows
    splitToRows = Table.ExpandListColumn(Table.TransformColumns(
        Source, {{"Text", Splitter.SplitTextByDelimiter("#(lf)", QuoteStyle.Csv), 
        let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Text"),

    //split on maximum 70 characters but only whole words.
    #"Invoked Custom Function" = Table.AddColumn(splitToRows, "fnSplitOnSpace", each fnSplitOnSpace([Text], 70)),

    //remove unneeded column
    #"Removed Columns" = Table.RemoveColumns(#"Invoked Custom Function",{"Text"}),

    //rename column: Text
    #"Renamed Columns" = Table.RenameColumns(#"Removed Columns",{{"fnSplitOnSpace", "Text"}}),

    //expand list to new rows
    #"Expanded Text" = Table.ExpandListColumn(#"Renamed Columns", "Text")
in
    #"Expanded Text"

需要一个自定义函数


从
其他源/空白查询创建新查询

重命名查询（属性/名称）：
fnSplitOnSpace

M代码用于自定义功能

//https://community.powerbi.com/t5/Desktop/Query-Editor-to-Split-the-Text-String/td-p/142110
//马塞尔·比格
（文本字符串作为文本，行长作为数字）作为列表=>
让
fnWT=List.Generate（（）=>
[TextPart=if Text.Length（TextString）-1
然后是Text.Start（TextString，List.Min（{LineLength+1，Text.PositionOf（Text.Start（TextString，LineLength+1），“”，Occurrence.Last）}））
else Text.Start（TextString，List.Min（{LineLength，Text.Length（TextString）}）），
RemainingText=if Text.Length（TextString）-1
然后是Text.Trim（Text.End（TextString，Text.Length（TextString）-Text.Length（TextPart）-1））
else Text.Trim（Text.End（TextString，Text.Length（TextString）-Text.Length（TextPart））]，
每个Text.Length（[TextPart]）>0，
每个[TextPart=if Text.Length（[RemainingText]）-1
然后是Text.Sta
//https://community.powerbi.com/t5/Desktop/Query-Editor-to-Split-the-Text-String/td-p/142110
//Marcel Beug

(TextString as text, LineLength as number) as list =>
    let
    fnWT = List.Generate(() => 
                  [TextPart      = if Text.Length(TextString) <= LineLength
                                   then TextString 
                                   else if Text.PositionOf(Text.Start(TextString,LineLength + 1)," ",Occurrence.Last) > -1
                                        then Text.Start(TextString,List.Min({LineLength + 1,Text.PositionOf(Text.Start(TextString,LineLength + 1)," ",Occurrence.Last)}))
                                        else Text.Start(TextString,List.Min({LineLength,Text.Length(TextString)})),
                   RemainingText = if Text.Length(TextString) <= LineLength
                                   then "" 
                                   else if Text.PositionOf(TextPart," ") > -1 
                                        then Text.Trim(Text.End(TextString,Text.Length(TextString)-Text.Length(TextPart)-1))
                                        else Text.Trim(Text.End(TextString,Text.Length(TextString)-Text.Length(TextPart)))],

                   each Text.Length([TextPart])>0,

                   each [TextPart      = if Text.Length([RemainingText]) <= LineLength
                                         then [RemainingText]
                                         else if Text.PositionOf(Text.Start([RemainingText],LineLength + 1)," ",Occurrence.Last) > -1
                                              then Text.Start([RemainingText],List.Min({LineLength + 1,Text.PositionOf(Text.Start([RemainingText],LineLength + 1)," ",Occurrence.Last)}))
                                              else Text.Start([RemainingText],List.Min({LineLength,Text.Length([RemainingText])})),
                         RemainingText = if Text.Length([RemainingText]) <= LineLength
                                         then ""
                                         else if Text.PositionOf(TextPart," ") > -1
                                              then Text.Trim(Text.End([RemainingText],Text.Length([RemainingText])-Text.Length(TextPart)-1))
                                              else Text.Trim(Text.End([RemainingText],Text.Length([RemainingText])-Text.Length(TextPart)))],

                   each [TextPart])
in
    fnWT