Vba 在数组中转换并重新排列范围操作

我有以下代码。我将一步一步地解释这一点

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

---

下面是一些可能有用的代码

注：在另一张图纸上的

放线RNG=Sheet2.单元格（1,1）'单元格A2中，
单元格（1,1）
是单元格A1而不是A2

考虑：

Dim ValuesFormat1 as Variant

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

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)

about语句将Variant ValuesFormatIn转换为二维数组，并将该范围内的所有值加载到该数组中。通常在二维数组中，第一个维度用于列，第二个维度用于行。对于从工作表中读取或将写入工作表的数组，尺寸则相反。这就好像ValuesFormat的大小是这样的：

ReDim ValuesFormatIn(1 To 20, 1 To 3)

在原始代码中，通过一次移动一行单元格，将3*20范围转换为1*60范围。您可以使用
ReDim
语句增加或减少最后一个维度的出现次数，但没有标准函数可以将二维3*20元素数组转换为一维60元素数组。如果搜索“VBA数组”，您将找到执行此类转换的VBA例程。然而，我不相信这是最简单的办法

考虑：

Dim ValuesFormat1 as Variant

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

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)

这将调整值格式的大小，以便即使在输入值中未找到任何重复值，也可以接受整个输入值集。我们可以将这个数组写入一个工作表数组，其中尾随项未使用，因此我认为这是最简单的方法

然后，这段代码会将数组值formatin中的值移动到数组值formatiout，并对与其前一个值匹配的任何值进行排序

  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

我建议你尝试一下，然后带着你遇到的任何具体问题回来。非常感谢@Tony我将修改我的代码并返回。。。感谢专家的建议…亲爱的@tony dallimore，太棒了。。这段代码非常适合我..我避免了将此数组转换为二维。。还有一些小问题。。我怎样才能在sheet2上按列而不是按行书写。。。要转换的值…？@Yogesh.Kale我相信您可以使用工作表函数。在工作表和数组之间的转换中进行转换，尽管我从未尝试过。控制输出数组维数的是
NumRowsOut
和
NumColsOut
的值。
RowInCrnt
和
colincnt
的For循环控制从输入数组中提取值的顺序。
rowut
和
ColOutCrnt
的值控制数据输出的顺序。通过调整这些，您应该能够根据新的需求更改输出阵列的排列。