我试图弄清楚如何拆分数据行,其中行中的 B、C、D 列包含多行,而其他列不包含多行。我已经弄清楚如何拆分多行单元格,如果我将这些列复制到新工作表中,手动插入行,然后运行下面的宏(仅适用于 A 列),但我在编码时迷失了休息。
Here's what the data looks like:
因此,对于第 2 行,我需要将其分为 6 行(单元格 B2 中的每一行各一行),其中单元格 A2 中的文本位于 A2:A8 中。我还需要将 C 列和 D 列按照与 B 相同的方式进行拆分,然后E栏:CP与A列相同。
这是我用于拆分 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
以下是示例文件的链接(请注意,该文件有 4 行,实际工作表有超过 600 行):https://www.dropbox.com/s/46j9ks9q43gwzo4/Example%20Data.xlsx?dl=0 https://www.dropbox.com/s/46j9ks9q43gwzo4/Example%20Data.xlsx?dl=0
这是一个相当有趣的问题,我以前见过一些不同的问题。我继续为它编写了一个通用解决方案,因为它似乎是一段值得我自己保留的有用代码。
我对数据几乎只有两个假设:
- 返回值表示为
Chr(10)
或者哪个是vbLf
持续的。
- 属于较低行的数据有足够的返回值以使其对齐。这似乎是你的情况,因为有返回字符似乎使事情按照你想要的方式排列。
输出的图片,缩小以显示所有数据A:D
。注意下面的代码默认处理所有列并输出到新工作表。如果需要,您可以限制列数,但它是too很容易将其变得通用。
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
怎么运行的
代码中有注释来突出显示正在发生的事情。以下是高级概述:
- 总的来说,我们迭代数据的每一行,单独处理所有列。
- 当前单元格的文本是
Split
使用vbLf
。这给出了所有单独行的数组。
- 计数器正在跟踪添加的最大行数(实际上这是
rows-1
因为这些数组是0-indexed
.
- 现在可以将数据输出到新工作表中。这很容易,因为我们可以转储数组
Split
为我们创造的。唯一棘手的部分是将其放置在纸张上的正确位置。为此,有一个用于当前列偏移的计数器和一个全局计数器来确定需要偏移的总行数。这Offset
将我们移动到正确的单元格;这Resize
确保输出所有行。最后,Application.Transpose
需要因为Split
返回一个行数组,我们正在转储一列。
- 更新计数器。列偏移量每次都会增加。更新行偏移量以添加足够的行来覆盖最后一个最大值 (
+1
因为这是0-indexed
)
- 最后,我到达使用我的瀑布填充(您之前的问题) https://stackoverflow.com/questions/30537813/count-lines-of-text-in-a-cell/30538117#30538117在为确保没有空白而创建的所有空白单元格上。我放弃错误检查,因为我假设存在空白。
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)