【问题标题】:How to populate to an array using VBAHow to populate to an array using VBA
【发布时间】:2022-12-02 02:48:57
【问题描述】:

Below is the code I have. I am looking to loop through the blank cells in the range to return the values. I want to then add these values to a list and print them.

Sub NDJList()

Dim List() As Variant
Dim Alert, Today As Date
Dim Days, Due As Integer
Dim rng, Cell As Range
Dim x As Long

On Error Resume Next
    ActiveSheet.ShowAllData
'Determine the data to store
Set rng = Range(Range("C4"), Range("C" & Rows.Count).End(xlUp))
With rng
    .AutoFilter 7, ""
    Set blanks = .Offset(1, 0).SpecialCells(xlCellTypeVisible)

'Resize Array prior to loading data
ReDim List(blanks.Rows.Count)

'Loop through each cell in range and store value in Array
    For Each Cell In blanks
        Alert = Cell.Offset(0, 4)
        Today = Format(Now(), "dd-mmm-yy")
        Days = Alert - Today
        'Due = Days * (-1)
        List(x) = Array(Cell.Offset(0, 3).Value)
        x = x + 1
    Next Cell
 'Print values to Immediate Window
        For x = LBound(List) To UBound(List)
            Debug.Print List(x)
        Next x
End With
End Sub

All it does is return a blank value in the Immediate window

【问题讨论】:

  • I don't know that this solves the problem, but it might. Drop the ARRAY() function from the List(x) = Array(Cell.Offset(0, 3).Value) line. You are wanting to retrieve a value from a cell and add it to the List array. It doesn't make sense to wrap the value returned from the cell in Array() for this.
  • FYI Dim rng, Cell As Range declares rng as Variant - every variable needs a type, otherwise it's a Variant.
  • .AutoFilter 7, "" - but the range is only one column? Suggest you remove On Error Resume Next and see whether you get any errors.
  • I suspect that @TimWilliams suggestion to drop ON ERROR RESUME NEXT may be illuminating for that problem. There may be an index-out-of-bound error being thrown as you iterate the blank range and assign values to elements of the array. And that potential error may stem from your redim, lack of initialization of your x variable (x=0 before iterating would be appropriate), and the fact that arrays are zero-based. That's a bit of a guess though.
  • Can you try explainingin wordswhat you try accomplishing? What do you expect from .AutoFilter 7, "" filtering in column "C:C" range? Do you want filtering the whole sheet on its column "G:G"? Are the headers on the fourth row? Then, in a discontinuous range blanks.Rows.Count returns only the rowsof the first range area. From which column do you want returning in the mentioned array? From "F:F" and "G:G"? And, as stated above, On Error Resume Next only not let you seeing the raised errors... If you do not know how using ActiveSheet.ShowAllData, On Error GoTo 0 is nec after

标签: excel vba


【解决方案1】:

Please, try the next adapted code. If filters the used range of the active sheet, filters on the blank cells of "G:G" column, set the array dimensions using Subtotal and returns in array from column "F:F". There are Date calculations not used in the code, I do not understand where to be used...:

Sub NDJList()
 Dim List() As Variant, Alert As Date, Today As Date
 Dim Days As Integer, Due As Integer
 Dim rng As Range, Cell As Range, x As Long, rowsCount As Long

 If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

 'Determine the data to store:???
 Set rng = Range(Range("C4"), Range("C" & rows.count).End(xlUp))

 ActiveSheet.AutoFilter 7, "" 'filter the activesheet used range
 rowsCount = Application.WorksheetFunction.Subtotal(3, rng) - 1 'numbers of rows in discontinuous range, except headers one
 With rng
        Set blanks = .Offset(1).Resize(rng.rows.count - 1).SpecialCells(xlCellTypeVisible)
    
       'Resize Array prior to loading data
       ReDim List(rowsCount - 1) 'zero based array...
    
       'Loop through each cell in range and store value in Array
        For Each Cell In blanks
            'Alert = Cell.Offset(0, 4)   '??? not used...
            'Today = Format(Now(), "dd-mmm-yy") '??? not used...
            'Days = Alert - Today       '??? not used...
            List(x) = Cell.Offset(, 3).Value: x = x + 1
      Next Cell
 End With
 
  'Print values to Immediate Window
  For x = LBound(List) To UBound(List)
        Debug.Print List(x)
  Next x

End Sub

Commented the unused lines. Anyhow, Offset(,4) should return from the filtered column, meaning only blank cells, making the respective lines raising errors...

Not tested, but it should work.

【讨论】:

    猜你喜欢
    • 2022-12-27
    • 2022-12-02
    • 2022-12-01
    • 2022-12-02
    • 2022-12-19
    • 2022-12-26
    • 2022-12-01
    • 2022-12-27
    • 1970-01-01
    相关资源
    最近更新 更多