Excel vba умная таблица в массив

Администратор

• Administrator
• Сообщения: 2,251
• Записан

Эксель-функции вида «application.INDEX» в данном случае не получится использовать в макросе, т.к. у вас формула массива. Макросу как-то надо указать, что нужно использовать эксель-функции так, как если бы используется формула массива, но такое сделать нельзя.

Остаётся два варианта:
1) Вставка формулы в ячейку, а затем превращение её в значение. В этом случае можно попробовать использовать:
ActiveCell.FormulaArray
2) Делать те же действия, что делает ваша формула, но без использования формул, а какими-нибудь другими способами: в программировании очень часто одно и то же можно делать несколькими способами.

Администратор

• Administrator
• Сообщения: 2,251
• Записан

То есть второй способ отпадает. Остаётся первый с использованием «ActiveCell.FormulaArray» (вместо «ActiveCell» нужная ячейка).
Или вариант вообще без использования эксель-функций.

Администратор

• Administrator
• Сообщения: 2,251
• Записан

Использование вашего первого способа. Вашу формулу оставил без изменений, только заключил в кавычки — в VBA формулу надо заключать в кавычки, а спереди нужно ставить знак равно:

Этот макрос вставляет формулу на активный лист в C3, а затем превращает формулу в значение, чтобы формулы не нагружали файл.

Sub макрос()

    With Range(«c3»)
        .FormulaArray = «=INDEX(Таблица1[Значение на начало часа],MATCH(R2C&RC1&RC2,Таблица1[Тег ]&Таблица1[Дата]&Таблица1[Час],0))»
        .Value = .Value
    End With

    End Sub

Кроме того. при работе с большим кол-вом формул или данных используйте формат «xlsb», он уменьшает размер файла и ускоряет работу формул. Формат xlsm нужен для взаимодействия с другими программами с помощью xml, а для всех остальных случаев не имеет смысла его использовать.

Администратор

• Administrator
• Сообщения: 2,251
• Записан

Можно попробовать сделать макрос, в котором не будет эксель-функций. То есть сам VBA может сделать то же самое.

Администратор

• Administrator
• Сообщения: 2,251
• Записан

Если вы что-то не поняли, то можете спросить.

I use this formula to copy unique records from Column A into Column B.

Range("A1", Range("A100").End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True

Instead of copying it into Column B how do you put the filtered results into an array in Excel VBA?

asked Aug 16, 2012 at 21:33

Just in case anyone ever looks at this again…
I created this function to work on a 1-D range but it will also write a higher dimension range to a 1-D array; it shouldn’t be too hard to modify to write a multiple dimension range to a «same shape» array. You need to have a reference to scrrun.dll to create the dictionary object. Scaling may be a problem since a «for each» loop is used but if you are using EXCEL this is likely nothing you are worried about:

Function RangeToArrUnique(rng As Range)
    Dim d As Object, cl As Range
    Set d = CreateObject("Scripting.Dictionary")
    For Each cl In rng
        d(cl.Value) = 1
    Next cl
    RangeToArrUnique = d.keys
End Function

I’ve tested this in this way:

Dim dat as worksheet
set dat = sheets("Data")
roomArr = Array("OR01","OR02","OR03")
dat.UsedRange.AutoFilter field:=2, criteria1:=roomArr, operator:=xlFilterValues
fltArr = RangeToArrUnique(dat.UsedRange.SpecialCells(CellTypeVisible))

Hope this helps someone out there!

answered Jan 20, 2016 at 15:26

Sub tester()

    Dim arr
    arr = UniquesFromRange(ActiveSheet.Range("A1:A5"))
    If UBound(arr) = -1 Then
        Debug.Print "no values found"
    Else
        Debug.Print "got array of unique values"
    End If

End Sub


Function UniquesFromRange(rng As Range)
    Dim d As Object, c As Range, tmp
    Set d = CreateObject("scripting.dictionary")
    For Each c In rng.Cells
       tmp = Trim(c.Value)
       If Len(tmp) > 0 Then
            If Not d.Exists(tmp) Then d.Add tmp, 1
       End If
    Next c
    UniquesFromRange = d.keys
End Function

answered Aug 16, 2012 at 22:15

A simple way to store a filtered range in an array is to use the copy-paste trick. Create a worksheet and make it hidden or very hidden. Say its code name is sht_calc. This function will give you a 2D array unless you only have one column and the filtered rows are only one, which in that case it will be a simple variant variable and not an array

Function GetArrayFromFilteredRange(rng As Range) As Variant
    Dim arr As Variant
    
    sht_calc.Cells.Clear
    rng.Copy sht_calc.Range("A1")
    arr = sht_calc.UsedRange.Value
    
    GetArrayFromFilteredRange = arr
End Function

For example if you want to get the array of filtered rows in a table called Table1 in a worksheet with a code name of sht1 you can simply do this:

dim rng as range
arr = GetArrayFromFilteredRange(sht1.ListObjects("Table1").DataBodyRange.SpecialCells(xlCellTypeVisible))

arr=GetArrayFromFilteredRange(rng)

answered Jul 1, 2020 at 13:52

Here’s another way to do it. If there are no results it just does nothing.

Public Sub filteredRangeToArray(rg As Range, arr As Variant)

Dim i As Long
Dim j As Long
Dim row As Range
'If 0 results in Filter just exit
If Not rg.SpecialCells(xlCellTypeVisible).Count > 0 Then Exit Sub
i = 1
Erase arr
ReDim arr(1 To rg.Columns.Count, 1 To _
   rg.Columns(1).SpecialCells(xlCellTypeVisible).Count)
For Each row In rg.Rows
 If Not row.Hidden Then
  For j = LBound(arr, 1) To UBound(arr, 1)
  arr(j, i) = row.Cells(j)
  Next j
  i = i + 1
 End If
Next row
arr = WorksheetFunction.Transpose(arr)
End Sub

answered Apr 11, 2021 at 13:16

The following takes information from column A and gives a list. It assumes you have a «Sheet3» which is available for data input (you may wish to change this).

Sub test()

    Dim targetRng As Range
    Dim i As Integer

    Set targetRng = Sheets(3).Range("a1")
    Range("A1", Range("A999").End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=targetRng, Unique:=True

    Dim numbElements As Integer
    numbElements = targetRng.End(xlDown).Row
    Dim arr() As String

    ReDim arr(1 To numbElements) As String

    For i = 1 To numbElements
        arr(i) = targetRng.Offset(i - 1, 0).Value
    Next i

End Sub

answered Aug 16, 2012 at 21:58