How to use VBA dictionary to store discontinuous range-CodePudding

I have some testing data of different samples, some samples may be test more than 1, and I want the last test data of each sample if exists. I tried to use an array to store data and return it to the worksheet, but it is not efficient enough. So, this time I want to use the VBA dictionary to store the data of each sample and then return it to the target position.

If the range of each row is continuous, it is ok, I can use the sample number as key, and each row data of the sample as a value.

However, in reality, I need to skip unwanted column, I tried to use union function, such as dic(sample) = Union ( .Range(…), .Range(…) ). Sadly, it did not work. I want to know how to connect discontinuous ranges and use this combined range as the value of the dictionary.

Below is the VBA code, I can use a dictionary to store columns from B to E. Now I want to skip F, and store B to E, and G. I don't know how to modify the the code below to achieve my goal.

dic(sample) = .Range(.Cells(ii, 2), Cells(ii, 5))

Sub DeleteDuplicate2()

Dim tar_sheet As Worksheet, ii As Integer

Dim dic As Object, arr As Variant

Dim arr1, arr2, arr3, sample As String

Set tar_sheet = ThisWorkbook.Sheets("data")

Set dic = CreateObject("scripting.dictionary")

tar_sheet.Activate

With tar_sheet

    For ii = 3 To 7
    
        sample = .Cells(ii, 3).Value
        
        dic(sample) = .Range(.Cells(ii, 2), Cells(ii, 5))
    
    Next ii
    
    arr = dic.items

End With

'arr1 = arr
'arr2 = Application.Transpose(arr)
arr3 = Application.Transpose(Application.Transpose(arr))

tar_sheet.Cells(10, 2).Resize(dic.Count, 4) = arr3

Set dic = Nothing

End Sub

Wanted effect

CodePudding user response：

Build the target array from the source array by copying selected rows/columns.

Option Explicit

Sub DeleteDuplicate2()

    Dim tar_sheet As Worksheet
    Dim r As Long, i As Long, j As Long, lastRow As Long
    Dim dic As Object, arIn, arOut, sample
    
    Set tar_sheet = ThisWorkbook.Sheets("data")
    Set dic = CreateObject("scripting.dictionary")
    
    tar_sheet.Activate
    
    lastRow = 7
    With tar_sheet
        arIn = .Range("A3:BV" & lastRow).Value2
    
        For i = 1 To UBound(arIn)
            sample = Trim(arIn(i, 3))
            dic(sample) = i
        Next
        
        ReDim arOut(1 To dic.Count, 1 To 72)
        i = 0
        For Each sample In dic.keys
            r = dic(sample)
            
            i = i   1
            
            ' A to D
            For j = 1 To 4
               arOut(i, j) = arIn(r, j)
            Next
            ' G -
            For j = 5 To 72
               arOut(i, j) = arIn(r, j   2)
            Next
        Next
    
    End With
    tar_sheet.Cells(10, 2).Resize(UBound(arOut), 72) = arOut
    
    Set dic = Nothing

End Sub