VBA通過.SpecialCells（xlCellTypeVisible）合並自動過濾的單元格

Question

我有一個我的用戶已經采取的課程列表，我想添加他們擁有的車輛的訪問權限，以及公司是否已激活他們的徽章以使用車輛（叉車等）。 所以我想為用戶合並所有類的行，然后只有一個居中的答案。 當我逐步完成它看起來工作但最終結果是整個數據列被合並。 我的問題是語法是否錯誤，還是我嘗試執行Excel 2013中無法完成的操作。

我正在使用的代碼：

With Range("A1:K" & LastRow)
  For i = 1 To UBound(FleetID, 1)
    .AutoFilter Field:=5, Criteria1:=FleetID(i)

    LastFilteredRow = .SpecialCells(xlCellTypeVisible).Cells(Rows.Count, "A").End(xlUp).Row
    If LastFilteredRow > 1 Then
     With .SpecialCells(xlCellTypeVisible).Range("R2:R" & LastFilteredRow)
       .Select
       .Merge
       If FleetClass(i) = "Operator" Then .Value = "Standard" Else .Value = FleetClass(i)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
     End With 'std
     With .SpecialCells(xlCellTypeVisible).Range("S2:S" & LastFilteredRow)
       .Select
       .Merge
       .Value = FleetAct(i)
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
     End With ' ' active
    End If
  Next i
   .Columns("A:U").AutoFit
   .Columns("E").ColumnWidth = 11
   .Columns("H:I").ColumnWidth = 11
   .Columns("N:N").ColumnWidth = 2
 End With   'Range("A1:K" & LastRow)

我的結果如下

沒有合並

與合並

Answer 1

我想通了這個代碼我有2個錯誤。 第一個錯誤是我的范圍不正確，雖然它似乎沒有打破合並，但確實打破了我后來添加的代碼。 我在特殊細胞之后使用了Range，所以將細胞從片材的開頭合並到我的可見細胞的末端而不是合並我的范圍內的可見細胞所需的代碼因此

With Range("A1:T" & LastRow)
    For i = 1 To UBound(FleetID, 1)
      .AutoFilter Field:=5, Criteria1:=FleetID(i)
      LastFilteredRow = .SpecialCells(xlCellTypeVisible).Cells(Rows.Count, "A").End(xlUp).Row
      If LastFilteredRow > 1 Then
       With .Range("R2:R" & LastFilteredRow).SpecialCells(xlCellTypeVisible)
         .Merge
         If FleetClass(i) = "Operator" Then .Value = "Standard" Else .Value = FleetClass(i)
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlCenter
       End With 'std
       With .Range("S2:S" & LastFilteredRow).SpecialCells(xlCellTypeVisible)
         .Merge
         .Value = FleetAct(i)
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlCenter
       End With ' ' active
      End If
    Next i
   .Columns("A:U").AutoFit
   .Columns("E").ColumnWidth = 11
   .Columns("H:I").ColumnWidth = 11
   .Columns("N:N").ColumnWidth = 2
 End With   'Range("A1:T" & LastRow)