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

about语句将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

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

1 个答案: