VBA 循环到下一个可见单元格

Question

This is doing my head in now and I cannot seem to get it right, I basically want to loop through column AJ and then if it contains anything like School, it stamps "School" in Column A, however I have a filter on the data because I only need to do this to certain rows..

This code currently returns an error but i believe I am on the right track with it... Just need a pointer if possible please

Open to options on this to make things more efficient as I am a bit of a newbie at this.. I effectively need to make loads of filters and conditions so I will be repeating this code multiple times because we output different files based on the bucket column

Below is my revised code which is now working

Sub Bucket_macro()
Dim rFiltered As Range, rng As Range, c As Range
Dim lastrow As Long

'Insert Bucket Column
Range("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Value = "Bucket"

Range("Q:Q").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("Q1").Value = "Age"

'add formula for DOB
Sheets("Sheet 1").Range("$Q$2:$Q" & Sheets("Sheet 1").Range("C1048574").End(xlUp).Row & "").Formula = "=IF($O2="""","""",DATEDIF($O2,TODAY(),""Y""))"

'filter to NewID only
Sheets("Sheet 1").Range("$A$1:$BQ" & Sheets("Sheet 1").Range("C1048574").End(xlUp).Row & "").AutoFilter Field:=66, Criteria1:="New ID"


lastrow = Range("C1048574").End(xlUp).Row

'first condition based on occupation field
Set rng = Sheets("Sheet 1").Range("AJ2:AJ" & lastrow).SpecialCells(xlCellTypeVisible)

For Each c In rng.SpecialCells(xlCellTypeVisible)
'   c.Select
   If c.Value = "" Then
   'do nothing
   
   Else
        Select Case True
                
            Case (c.Value Like "*school*")
                c.Offset(0, -35).Value = "School"
            
            Case (c.Value Like "*nursery*")
                c.Offset(0, -35).Value = "School"

            Case (c.Value Like "*university*")
                c.Offset(0, -35).Value = "School"
                
            Case (c.Value Like "*university*")
                c.Offset(0, -35).Value = "School"
            
            Case (c.Value Like "*education*")
                c.Offset(0, -35).Value = "School"
                
            Case (c.Value Like "*college*")
                c.Offset(0, -35).Value = "School"
        End Select
    
    End If

Next c

'Next condition based on age
Set rng = Sheets("Sheet 1").Range("Q2:Q" & lastrow).SpecialCells(xlCellTypeVisible)

For Each c In rng.SpecialCells(xlCellTypeVisible)
'   c.Select
   If c.Value = "" Then
   'do nothing
   
   Else
        Select Case True
                
            Case (c.Value < 19)
                    c.Offset(0, -16).Value = "School"
                    
            End Select
    
    End If

Next c

'Next condition based on job.description
Set rng = Sheets("Sheet 1").Range("AN2:AN" & lastrow).SpecialCells(xlCellTypeVisible)

For Each c In rng.SpecialCells(xlCellTypeVisible)
'   c.Select
   If c.Value = "" Then
   'do nothing
   
   Else
        Select Case True
                
            Case (c.Value Like "*school*")
                c.Offset(0, -39).Value = "School"
                
            Case (c.Value Like "*academy*")
                c.Offset(0, -39).Value = "School"
                
            Case (c.Value Like "*college*")
                c.Offset(0, -39).Value = "School"
                
            Case (c.Value Like "*university*")
                c.Offset(0, -39).Value = "School"
                
            Case (c.Value Like "*nursery*")
                c.Offset(0, -39).Value = "School"
                    
            End Select
    
    End If

Next c

End Sub

Answer 1

It looks like you're at the early stages of your VBA learning, I think we can all remember what that was like. There's a number of observations and suggestions worth mentioning about your code. I've provided an alternative below with comments explaining what certain different parts are for etc.

There's nothing wrong with using a Case… approach, or even an If..Else If method. I've taken a slightly different approach in an effort to reduce the number of lines of code needed.

I'm not sure I like your overall approach – once you start inserting columns in a module that references specific columns, you can only run the code once – lest you end up in a very confused state. It was a bit tricky following your references as it was, and you may need to make some adjustments to suit. You don't turn the filter off at the end of your module – so I didn't either.

It works for me, let me know how you go with it.

    Option Compare Text '<~~ to ignore case in text comparisons
    Option Explicit     '<~~ to force declaration of all variables
    Sub Bucket_macro()
    'Declare all variables used
    Dim ws As Worksheet, c As Range, LastRow As Long, i
    
    Set ws = Worksheets("Sheet 1")              '<~~ change to whatever you called sheet 1
        
    ws.Range("A:A").Insert                      '<~~ insert both columns
    ws.Range("Q:Q").Insert                  
    
    ws.Range("A1").Value = "Bucket"             '<~~ add headings
    ws.Range("Q1").Value = "Age"
    
    LastRow = ws.Cells(Rows.Count, 3).End(xlUp).Row '<~~ get last row early
    
    'Add age formula
    With ws.Range("Q2:Q" & LastRow)
        .FormulaR1C1 = "=IF(RC15<>"""",DATEDIF(RC15, TODAY(),""Y""),"""")"
        .Value = .Value
    End With
    
    'Set filter on column BN to "New ID" only 
    ws.Range("BN:BN").AutoFilter Field:=1, Criteria1:="New ID"
    
    'First condition: based on Occupation
    For Each c In ws.Range("AJ2:AJ" & LastRow).SpecialCells(xlCellTypeVisible)
        For Each i In Array("school", "nursery", "university", "education", "college")
            If InStr(c.Value, i) > 0 Then ws.Cells(c.Row, 1).Value = "School"
        Next i
    Next c
    
    'Second condition: based on age
    For Each c In ws.Range("Q2:Q" & LastRow).SpecialCells(xlCellTypeVisible)
        If c.Value < 19 Then ws.Cells(c.Row, 1).Value = "School"
    Next c
    
    'Third condition: based on job description
    For Each c In ws.Range("AN2:AN" & LastRow).SpecialCells(xlCellTypeVisible)
        For Each i In Array("school", "academy", "college", "university", "nursery")
            If InStr(c.Value, i) > 0 Then ws.Cells(c.Row, 1).Value = "School"
        Next i
    Next c
    
    End Sub