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

以下是结果的前后：

<强> BEFORE

Before Macro: 的 AFTER

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

Excel VBA宏将长行拆分为多个相等长度的行

2 个答案: