操作列 VBA

问题描述

我已经为我的庞大数据集 VBA 编写了以下代码，我希望根据我的范围标准操作列，请帮忙。

Dim Ary As Variant,Nary As Variant
   
    Dim r As Long,Rw As Long
   
    With Sheets("Sheet1")

        Ary = .Range("A2:B" & .Range("A" & Rows.Count).End(xlUp).Row).Value2

    End With

    ReDim Nary(1 To UBound(Ary),1 To 1)
 
    With CreateObject("scripting.dictionary")
      
        For r = 1 To UBound(Ary)
         
            If Not .Exists(Ary(r,1)) Then

                .Add Ary(r,1),r

                Nary(r,1) = Ary(r,2)

            Else
        
                Rw = .Item(Ary(r,1))
        
                Nary(Rw,1) = Nary(Rw,1) + Ary(r,2)

            End If

        Next r

    End With

    Sheets("sheet1").Range("C2").Resize(UBound(Nary)).Value = Nary

Sheets("sheet1").Range("C2").Resize(UBound(Nary)).Value = Nary

我想按照以下标准重新排列列，

ColumnA = ColumnD (4)

ColumnB = ColumnN (14)

ColumnC - ColumnO (15)

请按照上述标准重新编码上面的 Ubound 和 Lbound 编码，因为我不太习惯使用数组

函数代码。

以上编码工作正常，我只想操作列。

谢谢

解决方法

获得第一笔金额

• 下面针对另一列中的每个唯一值汇总一列中的值，并将结果显示在每个唯一值第一次出现的行中的第三列中。

Option Explicit

Function getFirstSums( _
    ws As Worksheet,_
    ByVal LookUpColumn As Variant,_
    ByVal ValuesColumn As Variant,_
    Optional ByVal FirstRow As Long = 1) _
As Variant

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count,LookUpColumn).End(xlUp).Row
    
    Dim rng As Range
    Set rng = ws.Cells(FirstRow,LookUpColumn).Resize(LastRow - FirstRow + 1)
    
    Dim Lookup As Variant: Lookup = rng.Value
    Dim SumUp As Variant
    SumUp = rng.Offset(,ws.Columns(ValuesColumn).Column _
        - ws.Columns(LookUpColumn).Column).Value
    
    Dim rCount As Long: rCount = UBound(Lookup)
    Dim Result As Variant: ReDim Result(1 To rCount,1 To 1)
    
    Dim r As Long,rw As Long
    
    With CreateObject("Scripting.Dictionary")
        For r = 1 To rCount
            If Not .Exists(Lookup(r,1)) Then
                .Add Lookup(r,1),r
                Result(r,1) = SumUp(r,1)
            Else
                rw = .Item(Lookup(r,1))
                Result(rw,1) = Result(rw,1) + SumUp(r,1)
            End If
        Next r
    End With
    
    getFirstSums = Result

End Function

Sub TESTgetFirstSums()
    
    Const wsName As String = "Sheet1"
    Const LookUpColumn As Variant = "D"
    Const ValuesColumn As Variant = "N"
    Const ResultColumn As Variant = "O"
    Const FirstRow As Long = 2
    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim ary As Variant
    ary = getFirstSums(ws,LookUpColumn,ValuesColumn,FirstRow)

    ws.Range(ResultColumn & FirstRow).Resize(UBound(ary)).Value = ary

End Sub

Sub TESTgetFirstSumsSimple()
    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim ary As Variant
    ary = getFirstSums(ws,4,14,2)

    ws.Cells(2,15).Resize(UBound(ary)).Value = ary

End Sub

编辑：

• 或者你更愿意把它写成一个子过程：

---

Sub writeFirstSums( _
        ws As Worksheet,_
        ByVal LookUpColumn As Variant,_
        ByVal ValuesColumn As Variant,_
        ByVal ResultColumn As Variant,_
        Optional ByVal FirstRow As Long = 1)

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count,1)
            End If
        Next r
    End With
    
    ws.Cells(FirstRow,ResultColumn).Resize(UBound(Result)) = Result

End Sub

Sub TESTwriteFirstSumsSimple()
    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    writeFirstSums ws,15,2

End Sub