excel - 我有需要弹出框才能工作的 VBA 代码，我可以自动执行此操作吗

Question

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

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

无论如何我可以自动化这个，例如，如果我有一个从A1开始的1:30的列，我总是想使用这个范围，我想要的输出单元格是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