我有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