Преобразование и изменение диапазона диапазона в массиве

Question

У меня есть следующий код. Я объясню это шаг за шагом.

6001 1001 3001 
3001 1002 2001 
2001 1003 3002 
3002 1004 2002 
2002 1005 3003 
3003 1006 2003 

Эти данные расположены в один ряд, чтобы облегчить удаление дубликатов, поступающих в последовательности, как показано ниже:

6001 1001 3001 1002 2001 1003 3002 1004 2002 1005 3003 1006 2003 1007 3004 1008 6002 2001 1009 

Кроме того, это расположено в следующем формате:

6001 2003 1012 3006 
1001 1007 2005 1018 
3001 3004 1013 2002 
1002 1008 3010 2005 
2001 6002 1014 1019 
1003 2001 2006 3008 
3002 1009 1015 1020 
1004 3005 3009 2006 
2002 1010 1016  
1005 2004 2003  
3003 1011 2004  
1006 3007 1017  

Пожалуйста, помогите мне преобразовать этот код, чтобы использовать массив вместо сохранения данных в ячейки на разных листах.

Sub ARRANGE() 

Dim InputRng As Range, OutRng As Range 
Dim row As Integer 
Dim rng As Range, j As Long 
Dim lastRow As Long 


Set InputRng = Sheet1.Range("A1:C20") 'A1 to C20 range is selected for operation 

Set OutRng = Sheet2.Cells(1, 1) 'Cell A2 on another sheet 

'---as indicated below data is converted to single row 

Application.ScreenUpdating = False 
xRows = InputRng.Rows.Count 
xcols = InputRng.Columns.Count 
For i = 1 To xRows 
    InputRng.Rows(i).Copy OutRng 
    Set OutRng = OutRng.Offset(0, xcols + 0) 

Next 
Application.ScreenUpdating = True 

' duplicates comming one after other are deleted by below code 

row = 0 ' Initialize variable. 
For i = 1 To 3 * 20 
If Sheet2.Cells(1, i).Value = Sheet2.Cells(1, i + 1).Value Then 
Sheet2.Cells(1, i).Delete 
End If 
Next i 


' data is rearranged to creat 12 number of rows and dynamic number of colums 
j = 1 

     For i = 1 To Sheet2.Cells(1, Columns.Count).End(xlToLeft).Column Step 12 
      Set rng = Sheet2.Range(Sheet_Pipe_Config.Cells(1, i), Sheet2.Cells(1, i + 12)) 
      Sheet3.Cells(1, j).Resize(rng.Count - 1, 1) = Application.Transpose(rng) 

      j = j + 1 
     Next i 


End Sub 

Answer 1

Ниже приведены несколько фрагментов кода, которые могут помочь.

Примечание: в Set OutRng = Sheet2.Cells(1, 1) 'Cell A2 on another sheet, Cells(1,1) является ячейкой A1 не A2.

Рассмотрим:

Dim ValuesFormat1 as Variant 

ValuesFormatIn = Sheet1.Range("A1:C20").Value 

о заявлении преобразует Variant ValuesFormatIn в двухмерном массиве и загружает все значения из диапазона к нему. Обычно в 2D-массивах первое измерение относится к столбцам, а второе относится к строкам. Для массивов, которые считаются или должны быть записаны на рабочий лист, размеры являются наоборот. Это как если бы ValuesFormatIn просеивают так:

ReDim ValuesFormatIn(1 To 20, 1 To 3) 

В исходном коде, вы преобразовать диапазон 3 * 20 в диапазоне 1 * 60, перемещая ячеек строки в то время. Вы можете использовать оператор ReDim для увеличения или уменьшения числа вхождений последнего измерения, но нет стандартной функции, которая преобразует массив 2D, 3 * 20 элементов в массив размером 1D, 60 элементов. Если вы ищете «массивы VBA», вы найдете подпрограммы VBA, которые будут выполнять такие преобразования. Однако я не уверен, что это самый простой подход.

Рассмотрим:

Dim NumColsOut As Long 
Const NumRowsOut As Long = 12 
Dim ValuesFormatOut As Variant 

NumColsOut = (UBound(ValuesFormatIn, 1) * UBound(ValuesFormatIn, 2) _ 
                + NumRowsOut - 1) \ NumRowsOut 
ReDim ValuesFormatOut(1 To NumRowsOut, 1 To NumColsOut) 

Это размерами ValuesFormatOut, чтобы он мог принять весь набор входных значений, даже если не одно значения дубликата было найдено в пределах входных значений. Мы можем записать этот массив в массив рабочих таблиц с неиспользуемыми записями, поэтому я считаю, что это был бы самый простой подход.

Этот код затем перемещает значения внутри массива ValuesFormatIn в массив ValuesFormatout, деканируя любое значение, соответствующее его предшественнику.

Dim RowInCrnt As Long 
    Dim ColInCrnt As Long 
    Dim RowOutCrnt As Long 
    Dim ColOutCrnt As Long 
    Dim ValueCrnt As Long 
    Dim ValueLast As Long 

    ValueLast = -1  ' For the code below to work, -1 muat be an inpossible value 
    RowOutCrnt = 1 
    ColOutCrnt = 1 

    For RowInCrnt = 1 To UBound(ValuesFormatIn, 1) 
    For ColInCrnt = 1 To UBound(ValuesFormatIn, 2) 
     If ValuesFormatIn(RowInCrnt, ColInCrnt) <> "" And _ 
     IsNumeric(ValuesFormatIn(RowInCrnt, ColInCrnt)) Then 
     ValueCrnt = ValuesFormatIn(RowInCrnt, ColInCrnt) 
     If ValueLast <> ValueCrnt Then 
      ValuesFormatOut(RowOutCrnt, ColOutCrnt) = ValueCrnt 
      ValueLast = ValueCrnt 
      RowOutCrnt = RowOutCrnt + 1 
      If RowOutCrnt > NumRowsOut Then 
      ColOutCrnt = ColOutCrnt + 1 
      RowOutCrnt = 1 
      End If 
     End If 
     Else 
     ' Probably a blank cell 
     ValueLast = -1 
     End If 
    Next 
    Next 

Наконец, этот код будет выводить ValuesFormatOut

' Output ValuesFormatOut 
With Sheet2 
    .Range(.Cells(1, 1), .Cells(NumRowsOut, NumColsOut)).Value = ValuesFormatOut 
End With