Excel VBA宏将长行分成许多等长

Question

我目前正在处理一个问题，即我有一个 Excel 电子表格，我想在其上使用 VBA 宏。以下 3 行中的每一行都是连续的。

Name of Data                                                            
abc A1  B2  B4  C4  E2  F43 d4  V8  f9  k11 j20 …           x

cde A2  B3  B12 C6  E9  F34 d6  V4  f13 k111    j209    …           x

efg A3  B5  B7  C8  E11 F68 d19 V12 f91 k114    j2014   …           x
…       






Desired                                                         
abc A1  B2  B4  C4  E2  F43 d4  V8                          
abc f9  k11 j20 …                                           
cde A2  B3  B12 C6  E9  F34 d6  V4                          
cde f13 k111    j209    …                                           
efg A3  B5  B7  C8  E11 F68 d19 V12                         
efg f91 k114    j2014   …

我有每一行的数据名称，有些行可能是数百个条目，跨越数百列。 所以我想做的是让我的行长停止在 8 列宽。我希望宏可以检查每一行以查看长度是否大于8，插入具有相同数据名称的行并粘贴接下来的8列，从总列中减去并粘贴下一行，直到它已到达第一个长行的末尾，并继续检查所有行。从本质上讲，它节省了大量时间，从计算 8 列宽、剪切并粘贴到下面插入的行中，保留所有其他数据。我是新手，所以宏或 VBA 帮助很多赞赏。

谢谢， 约翰

Answer 1

下面的宏将完全按照您的要求执行。它有一些假设我会留给你解决，例如

• 数据在表 1 中
• 名称列始终为A，所有数据列均从B开始
• 一切都从单元格 A1 开始

此宏将遍历每一行，并且对于具有超过 9 个数据元素的行，它将创建一个新行并用之前的行 Name 和剩余的数据行填充它。它将继续这样做，直到每行少于或等于 8 个数据元素。

由于您说了很多行，最好关闭屏幕更新，就像在 for 循环之前 Application.ScreenUpdating = False 并在 for 循环之后重新打开它。

Public Sub SplitRows()

Dim rowRange As Variant
Dim colCount As Integer
Dim lastColumn As Long
Dim rowCount As Integer
rowCount = Cells(Rows.Count, "A").End(xlUp).Row

Dim i As Integer
i = 1
Do While (i < rowCount)
    lastColumn = Sheet1.Cells(i, Columns.Count).End(xlToLeft).Column
    colCount = Sheet1.UsedRange.Columns.Count
    rowRange = Range(Cells(i, 2), Cells(i, colCount))
    'if the row has more than 9 values (name column + 8 data columns)
    If Not lastColumn <= 8 Then
        Dim x As Integer
        'from column 2 (B, aka first data column) to last column
        For x = 2 To colCount - 1
           'if data is not empty AND x mod 8 is 1 (meaning 8 goes into x enough times to have a remainder of 1)
            If Not IsEmpty(rowRange(1, x - 1)) And (x Mod 8) = 1 Then
                Cells(i, 1).Offset(1).EntireRow.Insert  'insert new row below current row
                rowCount = rowCount + 1                 'update row count because we added a row
                Sheet1.Cells(i + 1, 1).Value = Sheet1.Cells(i, 1).Value     'set first column name
                Dim colsLeft As Integer
                For colsLeft = x To colCount - 1
                    'take data value from col 9 to end and populate newly created row
                    Sheet1.Cells(i + 1, colsLeft - 7).Value = rowRange(1, colsLeft)
                    Sheet1.Cells(i, colsLeft + 1).Value = ""    'set data value from col 9 on and set to empty
                Next
            Exit For    'exit loop, weve done all we need to and must now check the newly populated row
            End If
        Next
    End If
    i = i + 1
Loop
End Sub

这是之前和之后的结果：

之前

之后

Answer 2

啊，我在这方面做了一些尝试，但我必须去上班。也许它作为一个起点会有所帮助。

Public Sub Test()
Dim mastercell As Range
Set mastercell = ActiveWorkbook.Worksheets(1).Cells(1, 1)
Dim masterValue As String
masterValue = mastercell.Value

If GetCount(masterValue) > 8 Then
    Dim tempvalue As String
    tempvalue = masterValue
    Dim Rowcount As Integer
    Dim ColCount As Integer
    Rowcount = mastercell.Row
    ColCount = mastercell.Column + 1
    Do While GetCount(tempvalue) > 8
        Dim WriteValue As String
        WriteValue = GetFirstEight(tempvalue)
        ActiveWorkbook.Worksheets(1).Cells(Rowcount, ColCount).Value = WriteValue
        ColCount = ColCount + 1
        tempvalue = Replace(tempvalue, WriteValue, 0, 1)

    Loop
End If

End Sub

Private Function GetCount(str As String) As Integer
Dim Splitter As String
Splitter = " "
Dim SplitArray As Variant
 SplitArray = Split(str)
GetCount = UBound(SplitArray)
End Function

Private Function GetFirstEight(str As String) As String
Dim i As Integer
Dim NewString As String
Dim SplitArray() As String
SplitArray = Split(str)
For i = 0 To 7
    NewString = NewString & SplitArray(i) & " "
Next
GetFirstEight = NewString
End Function