2

我目前正在处理一个问题，我有一个 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 帮助。

谢谢，约翰

4

2 回答 2

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

这是之前和之后的结果：

前

宏之前： 后 宏之后：

于 2013-01-10T18:05:56.430 回答
0

啊，我尝试了一些沿着这条线，但我必须去工作。也许它作为一个起点是有帮助的。

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
于 2013-01-10T08:25:40.773 回答