vba - Excel/VBA -- 基于 abritrary col/row 中的 int 在下面创建行

Question

我正在制作一个 Excel 表来跟踪类(class)及其参与者。

格式是这样的:

01. Place  | Time | Date | Slots
02. SO.com   Now     Now     5
03. SE.com   Soon    Soon    10

等等。

此列表一次发送给我，其中包含 10 到 50 门类(class)，我想在同一个文件中跟踪每门类(class)的参与者。

所以理想情况下，我想运行一个宏，在 SO.com 的类(class)下，创建 5 个(参见 Slots)新行，然后将值 5 替换为刚刚创建的范围的 =COUNTBLANK，这样“插槽”值现在将显示有多少空闲插槽，而不是插槽总数。如果有人能指出我如何使宏组也成为创建的选择，则可以加分。

宏应该循环遍历整个工作表并对每门类(class)执行相同的操作。

结果应如下所示:

01. Place | Time | Date | Slots
02. SO.com  Now     Now     5
03. <empty>
04. <empty>
05. <empty>
06. <empty>
07. <empty>
08. SE.com  Soon    Soon    10
09. <empty>
10. <empty>
...

将参与者输入 Excel 字段是通过 copypasta 完成的，因为我有一个系统可以从不同的程序中大量导出这些信息。

我是 VBA 的新手，但下面是我开始构建此代码的初步尝试。我从网络的其他部分截取了一些代码，对 MSDN 进行了一些查找，并对其余部分进行了猜测，不足为奇的是，它还不能正常工作。我在以“Set cellCount = Worksheets [...]”开头的行上收到 object required 错误，但我不明白为什么。

对流程其他部分的任何输入(例如，如果您看到我的代码不管对象错误如何都是死胎)也值得赞赏。

Sub insertRowsCourseSpace()

    Dim i&
    Dim cellCount As Integer
    Dim a As Integer

    'Locate the column to look for course space values    
    Dim col_n As Long
        For f = 1 To NumCols
        If Cells(2, f).Value = "Slots" Then col_n = f 'Finding the cell with the given string sets the column number
    Next

    'If cell value is numerical, create rows equal to value
    For i = 1 To NumRows
        If IsNumeric(Worksheets(1).Range(col_n & i).Value) = True Then
            Set cellCount = Worksheets(1).Range(col_n & i).Value
            Set Worksheets(1).Range(col_n & i).Value = "=COUNTBLANK(ActiveCell.Offset(1):ActiveCell(Offset(1 + cellCount))"
            For j = 1 To cellCount
                ActiveCell.Offset(j).EntireRow.Insert
            Next j
    Next i

End Sub

编辑:

好的，新的尝试:

使用此工作簿: http://s000.tinyupload.com/?file_id=02770147469124312893

Sub insertRowsCourseSlots()

Dim i&
Dim cellCount As Integer
Dim cellValue As Integer
Dim a As String
Dim b As String

'Locate correct column to look for course slots
'Dim col_n As Long
'
'    For f = 1 To 15 'Course slots won't be located further out than 15 columns, arbitrary value
'    If Cells(2, f).Value = "Antall kursplass" Then col_n = f
'Next

'If cell value is numerical, insert number of rows equal to the cell value
For i = 3 To 400 '400 = Arbitrary number
    If IsNumeric(Sheets("Sheet1").Cells(2, i).Value) = True Then
        cellValue = Sheets("Sheet1").Cells(2, i).Value
        cellCount = cellValue
        a = ActiveCell.Offset(1)
        b = ActiveCell.Offset(1) + CStr(cellCount)
        Set Sheets("Sheet1").Cells(2, i).Value = "=COUNTBLANK(a:b)"
        For j = 1 To cellCount
            ActiveCell.Offset(j).EntireRow.Insert
        Next j
    End If
Next i 
End Sub

这给了我运行时错误'9'，下标超出范围，在 Set Sheets("Sheet1").Cells(2, i).Value = "=COUNTBLANK(a:b)"行

Answer 1

这是我对你的问题的看法。请注意，如果数据没有像您的顶级帖子中那样格式化，或者如果存在例如，您可能会遇到麻烦。是描述参与者数量的列中的空单元格。

至于您自己的代码，我并没有仔细研究它，因为我发现从头开始更容易，但从我所看到的情况来看，我强烈建议您使用 Option Explicit在模块的顶部，强制您声明所有变量。例如，您从哪里获取 NumCols 或 NumRows 的值？

至于为什么 sub 在它所做的那一行中止，我相信这是因为你传递给 Worksheets.Range() 的参数无效。

Sub insertRowsCourseSpace()
  Dim no_to_insert() As Variant, v As Variant, at_row_number As Long, i As Long

  no_to_insert = Range(Worksheets("Sheet1").Range("E2"), Worksheets("Sheet1").Range("E1048576").End(xlUp))
  at_row_number = 2

  For Each v In no_to_insert
    ' Inserts new rows
    Worksheets("Sheet1").Rows(CStr(at_row_number + 1) & ":" & CStr(at_row_number + CLng(v))).Insert shift:=xlDown
    ' Inserts formula
    Worksheets("Sheet1").Range("E" & CStr(at_row_number)).Formula = "=COUNTBLANK(B" & CStr(at_row_number + 1) & ":B" & CStr(at_row_number + CLng(v)) & ")"
    ' Name range
    Worksheets("Sheet1").Range("A2:E2").Offset(at_row_number - 2, 0).Resize(CLng(v) + 1, 5).Name = "Range" & CStr(i)
    i = i + 1
    ' Decides where to insert the new set of rows
    at_row_number = at_row_number + CLng(v) + 1
  Next
  With Worksheets("Sheet1").Range("A1")
    .Value = "01."
    .AutoFill .Resize(at_row_number, 1), xlFillSeries
  End With
End Sub

更新代码:

Sub insertRowsCourseSpace()
  Dim no_to_insert() As Variant, v As Variant, at_row_number As Long, i As Long

  no_to_insert = Range(Worksheets("Sheet1").Range("B3"), Worksheets("Sheet1").Range("B1048576").End(xlUp))
  at_row_number = 3

  For Each v In no_to_insert
    ' Inserts new rows
    Worksheets("Sheet1").Rows(CStr(at_row_number + 1) & ":" & CStr(at_row_number + CLng(v))).Insert shift:=xlDown
    ' Inserts formula
    Worksheets("Sheet1").Range("B" & CStr(at_row_number)).Formula = "=COUNTBLANK(A" & CStr(at_row_number + 1) & ":A" & CStr(at_row_number + CLng(v)) & ")"
    ' Name range
    Worksheets("Sheet1").Range("A3:H3").Offset(at_row_number - 3, 0).Resize(CLng(v) + 1, 8).Name = "Range" & CStr(i)
    i = i + 1
    ' Decides where to insert the new set of rows
    at_row_number = at_row_number + CLng(v) + 1
  Next
  'With Worksheets("Sheet1").Range("A1")
  '  .Value = "01."
  '  .AutoFill .Resize(at_row_number, 1), xlFillSeries
  'End With
End Sub