Question

下面是一些代码，可将excel中的长列拆分为较小的列。

这是通过单击模块，按F5并输入范围，输出起点和单元格范围来表示每列中的条目数来实现的。

无论如何，我可以自动执行此操作吗，例如，如果我有一个以1:30从A1开始的列，我总是想使用此范围，我想要的输出单元格是H25，我想要的数量根据我在G6单元格中输入的内容进行输入。

Sub SplitColumn()
    'Updateby20141106
    Dim rng As Range
    Dim InputRng As Range
    Dim OutRng As Range
    Dim xRow As Integer
    Dim xCol As Integer
    Dim xArr As Variant
    xTitleId     = "KutoolsforExcel"
    Set InputRng = Application.Selection
    Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type: = 8)
    xRow         = Application.InputBox("Rows :", xTitleId)
    Set OutRng   = Application.InputBox("Out put to (single cell):", xTitleId, Type: = 8)
    Set InputRng = InputRng.Columns(1)
    xCol         = InputRng.Cells.Count / xRow
    ReDim xArr(1 To xRow, 1 To xCol + 1)
    For i = 0 To InputRng.Cells.Count - 1
        xValue = InputRng.Cells(i + 1)
        iRow = i Mod xRow
        iCol = VBA.Int(i / xRow)
        xArr(iRow + 1, iCol + 1) = xValue
    Next
    OutRng.Resize(UBound(xArr, 1), UBound(xArr, 2)).Value = xArr
End Sub

Answer 1

我想你想要这样的东西...

那我们需要更改什么？...在VBA窗口中按F8键，我们可以逐步查看每一行的内容。

1-此部分定义了您要分割的范围，因此我们将其替换：

Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type: = 8)

到硬编码范围：

Set InputRng = Range("A1:A30")

2-下一部分定义要输出结果的单元格：

Set OutRng   = Application.InputBox("Out put to (single cell):", xTitleId, Type: = 8)

我们将其硬编码为单元格范围。

Set OutRng = Range("H22")

3-最后要编辑的部分是这个

xRow         = Application.InputBox("Rows :", xTitleId)

将采用您在G4中拥有的值

xRow = Cells(4, 7).Value

最后的修改可能会更加棘手。选择是硬编码的，因此我们不需要它。因此，我们可以删除行Set InputRng = Application.Selection

如果我们在G4中没有任何值，我们将得到除以0的错误。因此，我们创建了一个IF语句，如果单元格G4为0，则会显示一个消息框“ G4中没有值”。

修改后的代码：

Sub SplitColumn()
    'Updateby20141106
    Dim rng As Range
    Dim InputRng As Range
    Dim OutRng As Range
    Dim xRow As Integer
    Dim xCol As Integer
    Dim xArr As Variant
    xTitleId = "KutoolsforExcel"
    Set InputRng = Range("A1:A30")
    xRow = Cells(4, 7).Value
    Set OutRng = Range("H22")
    If xRow = 0 Then
        MsgBox "No value in G4"
        Exit Sub
    Else
        Set InputRng = InputRng.Columns(1)
        xCol = InputRng.Cells.Count / xRow
        ReDim xArr(1 To xRow, 1 To xCol + 1)
            For i = 0 To InputRng.Cells.Count - 1
                xValue = InputRng.Cells(i + 1)
                iRow = i Mod xRow
                iCol = VBA.Int(i / xRow)
                xArr(iRow + 1, iCol + 1) = xValue
            Next i
        OutRng.Resize(UBound(xArr, 1), UBound(xArr, 2)).Value = xArr
    End If
End Sub

我有需要弹出框才能工作的VBA代码，我可以自动化吗

1 个答案: