阵列处理VBA [英] Array processing VBA

问题描述

我正在为使用vba的繁琐任务提供解决方案的原型，因为我公司的安全性仅允许使用此方法，不能使用python或其他任何方法.

i'm prototyping a solution for a tidious task using vba because my company's security only allows this method, can't use python nor anything else.

我有一个5K +行和15列左右的表，我想根据搜索条件处理它以除去特定的列.

i have a table of 5K+ rows and about 15 columns, and i want to process it removing specific columns based on a search criteria.

这是到目前为止的代码

Sub RstCr()

Dim Sh As Worksheet
Dim Ar() As Variant
Dim Arr As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim p As Integer

Set Sh = Sheets("Sheet1")

Sh.Cells(1, 1).CurrentRegion.Select

Ar = Sh.Range("A1").CurrentRegion.Value
MsgBox UBound(Ar, 1)
Arr = Array("COFOR", "Tri", "Fournisseur", ".Tiers.All", "GrM")


For i = 0 To UBound(Arr)
   For j = 1 To UBound(Ar, 2)
    If Ar(1, j) = Arr(i) Then
     For k = j To UBound(Ar, 2) - 1
      For p = 1 To UBound(Ar, 1)
         Ar(p, k) = Ar(p, k + 1)
      Next p
     Next k
    End If
   Next j
   ReDim Preserve Ar(UBound(Ar, 1), UBound(Ar, 2) - 1)
 Next i

 Worksheets("Sheet2").Range("A1").Resize(UBound(Ar, 1) , UBound(Ar, 2)).Value = Ar


 End Sub

我的问题是:有经验的vba开发人员如何评价此代码，效率如何?此外，是否有比tetris方法更好的处理数组的方法(例如，删除列，除上述方法外没有其他方法).

My question is: how would an experienced vba developper rate this code, how efficient is it. Also, is there a better way to prcessing arrays other than the tetris approach (for example, to delete a column nothing works other than the method above).

该程序还有更多任务:-在特定列之间插入列-用包含相应单元格值的另一个表中可用的值填充这些列在第一个数组中-根据两列删除重复项-根据一列对数组行进行排序.

the program has more tasks: - Inserting columns between specific columns - filling those columns with values available in another table containing corresponding values of cells in the first array - removing duplicates based on two columns - sorting array rows based on one column.

继续使用当前的方法还是有意义的，或者有更好，更轻松的方法来实现它.

would continuing with the current approach still make sense or there is a better and easier way to do it.

谢谢.

推荐答案

过一会儿，这种嵌套循环方法将变得难以遵循.如果您打算进行大量此类处理，那么您确实需要减少main方法中的代码量，并使其易于遵循.下面的代码可能看起来工作过度，但是较小的可重用部分只编写了一次，然后您可以根据需要从代码的其他部分重用它们.

After a while that nested loop approach is going to get hard to follow. If you plan on doing much of this type of processing then you really need to reduce the volume of code in your main method and make it easier to follow. The code below might seem over-worked, but the smaller re-usable parts only get written once, then you can re-use them as needed from other parts of your code.

现在您的主要子对象只做一件事，您可以更轻松地阅读代码以找出是什么.

Now your main sub now only does one thing, and you can much more easily read the code to figure out what that is.

Sub ReworkMyData()

    Dim data, terms

    data = Sheets("Sheet1").Range("A1").CurrentRegion.Value
    terms = Array("COFOR", "Tri", "Fournisseur", ".Tiers.All", "GrM")

    RemoveMatchingColumns data, terms

    ArrayToSheet data, Worksheets("Sheet2").Range("A1")

End Sub

'remove all "columns" from data where the header matches an item in
'  the array "headers"
Sub RemoveMatchingColumns(data, headers)
    Dim i As Long
    i = UBound(data, 2)
    Do
        If Not IsError(Application.Match(data(1, i), headers, 0)) Then
            RemoveColumn data, i
            i = i - 1 'account for the removed column
        End If
        i = i - 1
    Loop While i > 0
End Sub

'remove a column at position "colNum"
Sub RemoveColumn(data, colNum As Long)
    Dim r As Long, c As Long
    For r = 1 To UBound(data, 1)
        For c = colNum To UBound(data, 2) - 1
            data(r, c) = data(r, c + 1)
        Next c
    Next r
    ReDim Preserve data(1 To UBound(data, 1), 1 To UBound(data, 2) - 1)
End Sub

Sub ArrayToSheet(data, rng As Range)
    With rng(1).Resize(UBound(data, 1), UBound(data, 2))
        .Value = data
    End With
End Sub

这篇关于阵列处理VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！