Question

我希望你能提供帮助。我在下面有一段代码。它被称为一个更大的部分，我在下面进一步添加。

如果K列中的单元格不是空白，我想要Public Sub BorderForNonEmpty()做的只是填充A：C范围内的空白单元格。目前我将范围设置为Set myRange = ActiveSheet.Range("A2:C252")这只是为了查看代码是否有效。它有效，但对于A2为空白的所有细胞显然填充黄色：C252

我希望我的代码要做的是查看第11列，如果第11列中没有BLANKS单元格单元格，并且A：C中有空白，那么是颜色。但是如果第11列中有空白单元格，请停止在A：C中查找空白颜色并继续使用其余代码。

我想要做的是为每个国家的A，B和C中的空白单元设置黄色

一如既往，我们非常感谢任何帮助。

我在下面添加了一些照片。

原始图片

比利时宏观之后

彩色空白单元格黄色代码

Public Sub BorderForNonEmpty()
    Dim myRange As Range
    Set myRange = ActiveSheet.Range("A2:C252")

    'clear all color
    myRange.Interior.ColorIndex = xlNone

    'color only blank cells
    myRange.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 6
End Sub

完整代码，打开一个对话框，将主工作簿拆分为第11列中按国家/地区筛选的单独工作簿

完整代码

Sub Open_Workbook_Dialog()

Dim my_FileName As Variant
Dim my_Workbook As Workbook

  MsgBox "Pick your CRO file" '<--| txt box for prompt to pick a file

  my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection

  If my_FileName <> False Then
    Set my_Workbook = Workbooks.Open(Filename:=my_FileName)



    Call Filter(my_Workbook) '<--|Calls the Filter Code and executes

  End If
End Sub

Public Sub Filter(my_Workbook As Workbook)
  Dim rCountry As Range, helpCol As Range
  Dim wb As Workbook
  With my_Workbook.Sheets(1) '<--| refer to data worksheet
    With .UsedRange
      Set helpCol = .Resize(1, 1).Offset(, .Columns.Count) '<--| get a "helper" column just at the right of used range, it'll be used to store unique country names in
    End With

   With .Range("A1:Y" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<--| refer to its columns "A:Y" from row 1 to last non empty row of column "A"
            .Columns(11).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=helpCol, Unique:=True '<-- call AdvancedFilter on 11th column of the referenced range and store its unique values in "helper" column
            Set helpCol = Range(helpCol.Offset(1), helpCol.End(xlDown)) '<--| set range with unique names in (skip header row)
            For Each rCountry In helpCol '<--| iterate over unique country names range (skip header row)
                .AutoFilter 11, rCountry.Value2 '<--| filter data on country field (11th column) with current unique country name
                If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell other than header ones has been filtered...
                    Set wb = Application.Workbooks.Add '<--... add new Workbook
                        wb.SaveAs Filename:=rCountry.Value2 '<--... saves the workbook after the country
                            .SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Range("A1")
                               ActiveSheet.Name = rCountry.Value2  '<--... rename it
                           .SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1") 'copy data for country under header
                           Sheets(1).Range("A1:Y1").WrapText = False 'Takes the wrap text off
                           ActiveWindow.Zoom = 55
                         Sheets(1).UsedRange.Columns.AutoFit 'Autofits the column
                         Call BorderForNonEmpty
                    wb.Close SaveChanges:=True '<--... saves and closes workbook
                End If
            Next
        End With
        .AutoFilterMode = False '<--| remove autofilter and show all rows back
    End With
    helpCol.Offset(-1).End(xlDown).Clear '<--| clear helper column (header included)
End Sub

Public Sub BorderForNonEmpty()
    Dim myRange As Range
    Set myRange = ActiveSheet.Range("A2:C252")

    'clear all color
    myRange.Interior.ColorIndex = xlNone

    'color only blank cells
    myRange.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 6
End Sub

Answer 1

更新***
试试这个。它将在列K上过滤非空白，然后将黄色添加到A列中的空白单元格：C。

Public Sub Filter
Dim wks As Worksheet

Set wks = ThisWorkbook.Sheets("Sheet1")

   With wks
     .AutoFilterMode = False
     .Range("A:K").AutoFilter Field:=11, Criteria1:="<>", Operator:=xlFilterValues
     .Range("A:C").SpecialCells(xlCellTypeBlanks).Interior.Color = 65535
     .AutoFilterMode = False
   End With 
 End Sub

仅当另一列中的单元格不为空时，范围内的VBA颜色填充单元格

1 个答案: