拆分具有多行文本和单行文本的行

本文介绍了拆分具有多行文本和单行文本的行的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述

我试图找出如何拆分数据行，行中的列B，C，D包含多行，而其他行不包含。我已经弄清楚如何分割多行单元格，如果我将这些列复制到一个新的工作表，手动插入行，然后运行下面的宏（这只是为列A），但我失去了编码休息。

这是数据的样子：

所以对于第2行，我需要将其拆分成6行（单元格B2中每一行一行），A2中的单元格A2中的文本：A8。我还需要列C和D分割与B相同，然后与列A相同的列E：CP 。

这是代码我已经拆分B，C，D列中的单元格：

Dim iPtr As Integer Dim iBreak As整数 Dim myVar As Integer Dim strTemp As String Dim iRow As Integer iRow = 0 对于iPtr = 1到单元格（Rows.Count，col）。 End（xlUp）.Row strTemp = Cells（iPtr1，1） iBreak = InStr（strTemp，vbLf）范围（C1）值= iBreak 直到iBreak = 0 如果Len（Trim（Left（strTemp，iBreak - 1）））> 0然后 iRow = iRow + 1 单元格（iRow，2）= Left（strTemp，iBreak - 1）如果 strTemp = Mid（strTemp，iBreak + 1） iBreak = InStr（strTemp，vbLf）循环如果Len（Trim（strTemp））> 0然后 iRow = iRow + 1 单元格（iRow，2）= strTemp 结束如果下一个iPtr End Sub

这是一个示例文件的链接（请注意，该文件有4行，实际工作表已超过600个）：创建的所有空白单元格，以确保没有空格。我放弃了错误检查，因为我假设存在空白。

I'm trying to figure out how to split rows of data where columns B,C,D in the row contain multiple lines and others do not. I've figured out how to split the multi-line cells if I copy just those columns into a new sheet, manually insert rows, and then run the macro below (that's just for column A), but I'm lost at coding the rest.

Here's what the data looks like:

So for row 2, I need it split into 6 rows (one for each line in cell B2) with the text in cell A2 in A2:A8. I also need columns C and D split the same as B, and then columns E:CP the same as column A.

Here is the code I have for splitting the cells in columns B,C,D:

Dim iPtr As Integer Dim iBreak As Integer Dim myVar As Integer Dim strTemp As String Dim iRow As Integer iRow = 0 For iPtr = 1 To Cells(Rows.Count, col).End(xlUp).Row strTemp = Cells(iPtr1, 1) iBreak = InStr(strTemp, vbLf) Range("C1").Value = iBreak Do Until iBreak = 0 If Len(Trim(Left(strTemp, iBreak - 1))) > 0 Then iRow = iRow + 1 Cells(iRow, 2) = Left(strTemp, iBreak - 1) End If strTemp = Mid(strTemp, iBreak + 1) iBreak = InStr(strTemp, vbLf) Loop If Len(Trim(strTemp)) > 0 Then iRow = iRow + 1 Cells(iRow, 2) = strTemp End If Next iPtr End Sub

Here is a link to an example file (note this file has 4 rows, the actual sheet has over 600): www.dropbox/s/46j9ks9q43gwzo4/Example%20Data.xlsx?dl=0

解决方案

This is a fairly interesting question and something I have seen variations of before. I went ahead and wrote up a general solution for it since it seems like a useful bit of code to keep for myself.

There are pretty much only two assumptions I make about the data:

• Returns are represented by Chr(10) or which is the vbLf constant.
• Data that belongs with a lower row has enough returns in it to make it line up. This appears to be your case since there are return characters which appear to make things line up like you want.

Pictures of the output, zoomed out to show all the data for A:D. Note that the code below processes all of the columns by default and outputs to a new sheet. You can limit the columns if you want, but it was too tempting to make it general.

Code

Sub SplitByRowsAndFillBlanks() 'process the whole sheet, could be 'Intersect(Range("B:D"), ActiveSheet.UsedRange) 'if you just want those columns Dim rng_all_data As Range Set rng_all_data = Range("A1").CurrentRegion Dim int_row As Integer int_row = 0 'create new sheet for output Dim sht_out As Worksheet Set sht_out = Worksheets.Add Dim rng_row As Range For Each rng_row In rng_all_data.Rows Dim int_col As Integer int_col = 0 Dim int_max_splits As Integer int_max_splits = 0 Dim rng_col As Range For Each rng_col In rng_row.Columns 'splits for current column Dim col_parts As Variant col_parts = Split(rng_col, vbLf) 'check if new max row count If UBound(col_parts) > int_max_splits Then int_max_splits = UBound(col_parts) End If 'fill the data into the new sheet, tranpose row array to columns sht_out.Range("A1").Offset(int_row, int_col).Resize(UBound(col_parts) + 1) = Application.Transpose(col_parts) int_col = int_col + 1 Next 'max sure new rows added for total length int_row = int_row + int_max_splits + 1 Next 'go through all blank cells and fill with value from above Dim rng_blank As Range For Each rng_blank In sht_out.Cells.SpecialCells(xlCellTypeBlanks) rng_blank = rng_blank.End(xlUp) Next End Sub

How it works

There are comments within the code to highlight what is going on. Here is a high level overview:

• Overall, we iterate through each row of the data, processing all of the columns individually.
• The text of the current cell is Split using the vbLf. This gives an array of all the individual lines.
• A counter is tracking the maximum number of rows that were added (really this is rows-1 since these arrays are 0-indexed.
• Now the data can be output to the new sheet. This is easy because we can just dump the array that Split created for us. The only tricky part is getting it to the right spot on the sheet. To that end, there is a counter for the current column offset and a global counter to determine how many total rows need to be offset. The Offset moves us to the right cell; the Resize ensures that all of the rows are output. Finally, Application.Transpose is needed because Split returns a row array and we're dumping a column.
• Update the counters. Column offset is incremented every time. The row offset is updated to add enough rows to cover the last maximum (+1 since this is 0-indexed)
• Finally, I get to use my waterfall fill (your previous question) on all of the blanks cells that were created to ensure no blanks. I forgo error checking because I assume blanks exist.