查找列标题并突出显示它,包括它的单元格

时间:2017-01-17 13:57:56

标签: vba excel-vba excel

enter image description here

// [[Rcpp::export]]
Rcpp::IntegerVector order_(Rcpp::NumericVector x, Rcpp::NumericVector y) {
  // sort x 
  Rcpp::NumericVector sorted_x = clone(x).sort();
  // find order of x only
  Rcpp::IntegerVector order = Rcpp::match(sorted_x, x);
  // find order of y for each order of x
  for (int i = 1; i <= Rcpp::max(order); ++i){
    Rcpp::LogicalVector duplicates = order == i;
    int k = which_max(duplicates);
    Rcpp::NumericVector duplicated_y = y[duplicates];
    Rcpp::NumericVector sorted_dy = clone(duplicated_y).sort();
    Rcpp::IntegerVector order_y = Rcpp::match(sorted_dy, duplicated_y);
    for (int j = 0; j < order_y.length(); ++j){
      order(k + j) = order(k + j) + order_y(j) - 1;
    }
  }
  return order;
}

使用此代码,我设法突出显示标题但我无法突出显示每个列标题Sun下的单元格。

2 个答案:

答案 0 :(得分:1)

如果你的代码没有抛出任何错误,那么你的Excel / VBE肯定有问题。

它应该抛出错误:

colName = Split(col.Cells(, col).Address, "$")(1)因为col声明为long,因此不应该有.cells属性。

lRow = .Range(colName & .Rows.Count).End(xlUp).Row Set rng = .Range(colName & "8:" & colName & lRow)  因为使用.Range你需要一个With Clause。

这应该是用颜色填充所有Sun列的正确代码。

Sub test()

    Dim headersRange As Range, cellsToloop As Range
    Dim rngFind As Range


    '/ Sheet1 is just an example name.
    Set headersRange = Sheet1.Range("HeadersToFind")

    '/ To Fill upto a specific value in a cell
    Set rngFind = Sheet1.Cells.Find("Total", , , xlWhole)

    For Each cellsToloop In headersRange
        If cellsToloop.Value = "Sun" Then
            '/ Fill all the way to last cell
            Sheet1.Range(cellsToloop, cellsToloop.End(xlDown)).Interior.Color = RGB(160, 160, 200)

            '/ Fill all they way upto usedrange's lastrow.
            cellsToloop.Resize(Sheet1.UsedRange.Rows.Count, 1).Interior.Color = RGB(160, 160, 200)

            '/ To Fill upto a specific value in a cell
            If Not rngFind Is Nothing Then
             cellsToloop.Resize(rngFind.Row, 1).Interior.Color = RGB(160, 160, 200)
            End If

        End If
    Next

End Sub

答案 1 :(得分:0)

你可以这样做

Option Explicit

Private Sub CommandButton2_Click()
    Dim headersRange As Range, totalCell As Range, sunCell As Range
    Dim firstAddress As String

    Set headersRange = Range("HeadersToFind")

    With headersRange
        Set totalCell = .Cells(1).End(xlDown).Offset(-1)
        Set sunCell = .Find("Sun", , xlValues, xlWhole)
        If Not sunCell Is Nothing Then
            firstAddress = sunCell.Address
            Do
                .Parent.Range(sunCell, .Parent.Cells(totalCell.Row, sunCell.Column)).Interior.Color = RGB(160, 160, 200)
                Set sunCell = .FindNext(sunCell)
            Loop While sunCell.Address <> firstAddress
        End If
    End With
End Sub

我认为:

  • 表在宏运行时始终为空

  • &#34;总&#34;始终位于headersRange第一栏

如果它们不正确,代码可以很容易地适应