添加數據透視表旁邊的複選框，直到數據透視表中最後一行信息被添加爲止

Question

親愛的所有人：我需要添加複選框到A列，即我的數據透視表左側，從B列開始到D列。我還希望複選框鏈接到數據透視表的最右側，即E列。

我找到了一個代碼。但限於特定範圍（「A4：A9」）。我希望代碼能夠動態地添加複選框，而不管數據透視表的長度是多少，以便換句話說就是最後一行。

附上整個代碼，我已經

Sub AddCheckBox() 
    Dim cell As Range 

    DelCheckBox 'Do the delete macro 
    'or delete all checkboxes in the worksheet 
    ' ActiveSheet.CheckBoxes.Delete 
    Dim MyRow As Long 

    lastrow = Cells.Find("*", Range("A1"), xlValues, , xlByRows, xlPrevious).Row 

    For Each cell In Range("A4:A9") 
     With ActiveSheet.CheckBoxes.Add(cell.Left, _ 
      cell.Top, cell.Width, cell.Height) 
      .LinkedCell = cell.Offset(, 4).Address(External:=True) 
      .Interior.ColorIndex = 37 'or xlNone or xlAutomatic 
      .Caption = "" 
      '.Border.Weight = xlThin 
     End With 
    Next 

    With Range("A4:A9") 
     .Rows.RowHeight = 15 
    End With 
End Sub 

---

Sub DelCheckBox() 
    For Each cell In Range("A4:A9") 
     Worksheets("Analysis").CheckBoxes.Delete 
    Next 
End Sub 

我發現，標識中的最後一行代碼。但是，我必須做錯事，因爲當我嘗試將其與代碼的其餘部分一起插入時，它似乎不起作用。事實上，我不知道我需要插入它才能正常工作。任何人都可以幫助我確定我需要做什麼嗎？

非常感謝您的幫助。

Answer 1

嘗試使用lastrow = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).end(xlUp).Row查找列中的最後一行而不是方法。也改變Range("A4:A9")到RangE("A4:A" & lastrow)任何地方，它是在你的代碼中引用（也改變了4所使用的細胞在A列第一行）的意見後

Source

更新下面

我上面修改了你的代碼。您的工作不像您在「計數」之前刪除複選框那樣工作。因此，它只是在第1到第4行中添加它們。如果將NoRow列E更改爲工作表中的恆定列，則會執行您想要的操作。

Sub AddCheckBox() 
    Dim cell 
    Dim NoRow As Integer: Dim firstRow As Integer 
    Dim ws As Worksheet 

    Set ws = ThisWorkbook.Worksheets("Analysis") 
    With ws 
     .CheckBoxes.Delete 
     ' Change the `E` to the column that the checkboxes are aligning with 
     NoRow = .Range("E" & .Rows.Count).End(xlUp).Row 
    End With 

    For Each cell In Range("A4:A" & NoRow) 
     With ws.CheckBoxes.Add(cell.Left, _ 
      cell.Top, cell.Width, cell.Height) 
      .LinkedCell = cell.Offset(, 4).Address(External:=True) 
      .Interior.ColorIndex = 37 'or xlNone or xlAutomatic 
      .Caption = "" 
      '.Border.Weight = xlThin 
     End With 
    Next 

    With ws.Range("A4:A" & NoRow).Cells 
     .Rows.RowHeight = 15 
    End With 
End Sub