Повторно потускневшие массивы в VBA

Примечание: я написал этот код в блокноте.
Дайте мне знать, если вы столкнетесь с какой-либо проблемой.

Sub group_data()
dim totalRows as integer
dim rowNum as integer
dim rowsWithoutNA as integer

dim c1Range as Range
dim ap1Range as Range
dim bm1Range as Range

set c1Range = Workbooks("restcompfirm.xls").Worksheets("Sheet1").Range("C1")
set ap1Range = Workbooks("restcompfirm.xls").Worksheets("Sheet1").Range("AP1")
set bm1Range = Workbooks("restcompfirm.xls").Worksheets("Sheet1").Range("BM1")


Dim country(), roe(), iCap() As String
Dim i As Integer

totalRows = 3357

redim country(totalRows)
redim roe(totalRows)
redim iCap(totalRows)

For i = 0 To (totalRows - 1)
   rowNum = rowNum + 1

   roe(rowsWithoutNA) = ap1Range.Offset(rowNum, 0).Text
   iCap(rowsWithoutNA) = bm1Range.Offset(rowNum, 0).Text

   if (WorksheetFunction.IsNA(roe(rowNum)) _
      OR WorksheetFunction.IsNA(iCap(rowNum))) = False Then
   ' use the following condition, if NA is written in text 
   'if (trim(roe(rowNum)) = "NA" OR trim(iCap(rowNum)) = "NA") Then
      country(rowsWithoutNA) = c1Range.Offset(rowNum, 0)
      rowsWithoutNA = rowsWithoutNA + 1
   end if
Next i 

redim preserve country(rowsWithoutNA )
redim preserve roe(rowsWithoutNA )
redim preserve iCap(rowsWithoutNA )

end sub

Для ясности, я предполагаю, что у вас есть список стран в диапазоне C1, а затем связанные значения roe и iCap в диапазоны AP1 и BM1. Проблема в том, что некоторые элементы roe и iCap отсутствуют и были введены как «NA». Вы хотите создать массивы, содержащие только страны, в которых есть значения iCap и iCap.

Во-первых, использование Redim Preserve является «дорогостоящей» операцией и повлияет на эффективность кода.

Во-вторых, в стороне, использование синтаксиса, как в вашем коде (ниже), установит только последнюю переменную в String. Первые два будут созданы как вариант типа переменной:

Dim country(), roe(), iCap() As String 

Этот код должен быть записан как:

Dim country() as String, roe() as String, iCap() As String 

Что касается вашей проблемы, мой подход будет следующим:

Sub FillArrays()
'Define arrays
Dim countryArray() As String, roeArray() As Variant, iCapArray() As Variant

'Get total number of countries
Dim totalRows As Long
totalRows = Workbooks("restcompfirm.xls").Worksheets("Sheet1").Range("C1").End(xlDown).Row

'Define array size based on totalRows
ReDim countryArray(totalRows - 1)
ReDim roeArray(totalRows - 1)
ReDim iCapArray(totalRows - 1)

'Define missing data text
Dim missingData As String
missingData = "NA"

Dim iArray As Long
iArray = 0

With Workbooks("restcompfirm.xls").Worksheets("Sheet1")

'Loop through each row and check if either roe or iCap are set to 'NA'
For cl = 1 To totalRows

    If Trim(.Range("AP" & cl)) <> missingData Then
        If Trim(.Range("BM" & cl)) <> missingData Then

            countryArray(iArray) = .Range("C" & cl)
            roeArray(iArray) = .Range("AP" & cl)
            iCapArray(iArray) = .Range("BM" & cl)

            iArray = iArray + 1
        End If
    End If

Next cl

End With

End Sub

Надеюсь, это поможет.