1

我正在尝试对输出变量进行软编码,这样我就不必每次需要修改输出时都修改 VBA 代码。

这是有效的代码

Sub Working()
    Dim cat(1 To 10)
    Dim bat(1 To 10)

    For i = 1 To 10
        cat(i) = i * 10
        bat(i) = i * 5
    Next i

    Sheet2.Range("A2:A11") = Application.Transpose(cat())
    Sheet2.Range("B2:B11") = Application.Transpose(bat())
End Sub

这是我想写的理想方式,但不起作用

Sub not_working()
    Dim cat(1 To 10)
    Dim bat(1 To 10)

    For i = 1 To 10
        cat(i) = i * 10
        bat(i) = i * 5
    Next i

    a = 3
    Do While Sheet1.Cells(a, 1) <> ""
        OutVar = Sheet1.cells(a, 1) & "()" 
        Sheet3.Range( _
            Cells(2, a - 2).Address, Cells(11, a - 2).Address _
        ) = Application.Transpose(Outvar)
        a = a + 1
    Loop
End Sub

' Sheet1.cells(3,1) = cat - these cells contain the variable names
' Sheet1.cells(4,1) = bat - these cells contain the variable names

有人可以建议是否可以这样做?

4

1 回答 1

-1

如果我正确理解您的要求,一个参差不齐的数组将满足它。

如果您有一个 Variant 类型的变量,您可以将该变量设置为例如整数、实数、字符串、布尔值或数组。

如果您有一个 Variant 类型的数组,则可以将该数组的每个元素设置为不同类型的值。

在下面的代码中,我有变体数组 Main。我设置:

  • Main(0) 到一维数组,
  • Main(1) 到更大的一维数组,
  • Main(2) 到二维数组,
  • Main(3) 转换为单个整数,
  • Main(4) 到工作表的使用范围。

这被称为不规则数组,因为每个元素的大小不同。

用值加载数组后,我使用通用例程根据其性质输出 Main 的每个元素。

您的 200-300 个变量中的每一个都将成为 Main 的一个元素。

看看我的代码。这只是对变体数组可以实现的功能的简要介绍。如果您认为我正朝着正确的方向前进但还不够远,请回来提出问题。

Option Explicit
Sub DemoRaggedArray()

  Dim InxDim As Long
  Dim InxMain As Long
  Dim InxWCol As Long
  Dim InxWRow As Long
  Dim Main() As Variant
  Dim NumOfDim As Long
  Dim Work() As Variant

  ReDim Main(0 To 5)

  Work = Array(1, "A", True)

  Main(0) = Work

  Main(1) = Array(2, "B", False, 1.2)

  ReDim Work(1 To 2, 1 To 3)

  Work(1, 1) = 1
  Work(1, 2) = 2.5
  Work(1, 3) = DateSerial(2012, 12, 27)
  Work(2, 1) = True
  Work(2, 2) = "String"

  Main(2) = Work

  Main(3) = 27

  ' Cells A1:C4 of the worksheet have been set to their addresses
  Main(4) = WorksheetFunction.Transpose(Worksheets("Sheet2").UsedRange.Value)

  For InxMain = LBound(Main) To UBound(Main)
    Debug.Print "Type of Main(" & InxMain & ") is " & VarTypeName(Main(InxMain))
    Select Case VarType(Main(InxMain))
      Case vbEmpty, vbNull
        ' No value
      Case Is >= vbArray
        ' Array
        NumOfDim = NumDim(Main(InxMain))
        Debug.Print "  Main(" & InxMain & ") is dimensioned as: (";
        For InxDim = 1 To NumOfDim
          Debug.Print LBound(Main(InxMain), InxDim) & " To " & _
                                                  UBound(Main(InxMain), InxDim);
          If InxDim < NumOfDim Then
            Debug.Print ", ";
          End If
        Next
        Debug.Print ")"
        Select Case NumOfDim
          Case 1
            For InxWCol = LBound(Main(InxMain)) To UBound(Main(InxMain))
              Debug.Print "  (" & InxWCol & ")[" & _
                                        VarTypeName(Main(InxMain)(InxWCol)) & "]";
              Select Case VarType(Main(InxMain)(InxWCol))
                Case vbEmpty, vbNull, vbArray
                  ' No code to handle these types
                Case Else
                  Debug.Print "=" & Main(InxMain)(InxWCol);
              End Select
            Next
            Debug.Print
          Case 2
            For InxWRow = LBound(Main(InxMain), 2) To UBound(Main(InxMain), 2)
              For InxWCol = LBound(Main(InxMain), 1) To UBound(Main(InxMain), 1)

                Debug.Print "  (" & InxWCol & "," & InxWRow & ")[" & _
                             VarTypeName(Main(InxMain)(InxWCol, InxWRow)) & "]";
                Select Case VarType(Main(InxMain)(InxWCol, InxWRow))
                  Case vbEmpty, vbNull, vbArray
                    ' No code to handle these types
                  Case Else
                    Debug.Print "=" & Main(InxMain)(InxWCol, InxWRow);
                End Select
              Next
              Debug.Print
            Next
          Case Else
            Debug.Print "  There is no display code for this number of dimensions"
        End Select
      Case Else
        ' Single variable
        Debug.Print "  Value = " & Main(InxMain)
    End Select
  Next

End Sub
Public Function NumDim(ParamArray TestArray() As Variant) As Integer

  ' Returns the number of dimensions of TestArray.

  ' If there is an official way of determining the number of dimensions, I cannot find it.

  ' This routine tests for dimension 1, 2, 3 and so on until it get a failure.
  ' By trapping that failure it can determine the last test that did not fail.

  ' Coded June 2010. Documentation added July 2010.

  ' *  TestArray() is a ParamArray because it allows the passing of arrays of any type.
  ' *  The array to be tested in not TestArray but TestArray(LBound(TestArray)).
  ' *  The routine does not validate that TestArray(LBound(TestArray)) is an array.  If
  '    it is not an array, the routine return 0.
  ' *  The routine does not check for more than one parameter.  If the call was
  '    NumDim(MyArray1, MyArray2), it would ignore MyArray2.

  Dim TestDim                   As Integer
  Dim TestResult                As Integer

  On Error GoTo Finish

  TestDim = 1
  Do While True
    TestResult = LBound(TestArray(LBound(TestArray)), TestDim)
    TestDim = TestDim + 1
  Loop

Finish:

  NumDim = TestDim - 1

End Function
Function VarTypeName(Var As Variant)

  Dim Name As String
  Dim TypeOfVar As Long

  TypeOfVar = VarType(Var)

  If TypeOfVar >= vbArray Then
    Name = "Array of type "
    TypeOfVar = TypeOfVar - vbArray
  Else
    Name = ""
  End If

  Select Case TypeOfVar
    Case vbEmpty
      Name = Name & "Uninitialised"
    Case vbNull
      Name = Name & "Contains no valid data"
    Case vbInteger
      Name = Name & "Integer"
    Case vbLong
      Name = Name & "Long integer"
    Case vbSingle
      Name = Name & "Single-precision floating-point number"
    Case vbDouble
      Name = Name & "Double-precision floating-point number"
    Case vbCurrency
      Name = Name & "Currency"
    Case vbDate
      Name = Name & "Date"
    Case vbString
      Name = Name & "String"
    Case vbObject
      Name = Name & "Object"
    Case vbError
      Name = Name & "Error"
    Case vbBoolean
      Name = Name & "Boolean"
    Case vbVariant
      Name = Name & "Variant"
    Case vbDataObject
      Name = Name & "Data access object"
    Case vbDecimal
      Name = Name & "Decimal"
    Case vbByte
      Name = Name & "Byte"
    Case vbUserDefinedType
      Name = Name & "Variants that contain user-defined types"
    Case Else
      Name = Name & "Unknown type " & TypeOfVar
  End Select

  VarTypeName = Name

End Function

DemoRaggedArray的输出

Type of Main(0) is Array of type Variant
  Main(0) is dimensioned as: (0 To 2)
  (0)[Integer]=1  (1)[String]=A  (2)[Boolean]=True
Type of Main(1) is Array of type Variant
  Main(1) is dimensioned as: (0 To 3)
  (0)[Integer]=2  (1)[String]=B  (2)[Boolean]=False  (3)[Double-precision floating-point number]=1.2
Type of Main(2) is Array of type Variant
  Main(2) is dimensioned as: (1 To 2, 1 To 3)
  (1,1)[Integer]=1  (2,1)[Boolean]=True
  (1,2)[Double-precision floating-point number]=2.5  (2,2)[String]=String
  (1,3)[Date]=27/12/2012  (2,3)[Uninitialised]
Type of Main(3) is Integer
  Value = 27
Type of Main(4) is Array of type Variant
  Main(4) is dimensioned as: (1 To 3, 1 To 4)
  (1,1)[String]=A1  (2,1)[String]=B1  (3,1)[String]=C1
  (1,2)[String]=A2  (2,2)[String]=B2  (3,2)[String]=C2
  (1,3)[String]=A3  (2,3)[String]=B3  (3,3)[String]=C3
  (1,4)[String]=A4  (2,4)[String]=B4  (3,4)[String]=C4
Type of Main(5) is Uninitialised

请注意,日期显示为“27/12/2012”,因为这是我所在国家/地区的默认日期格式。如果您运行此代码,它将以您所在国家/地区的默认格式显示。

于 2012-12-27T19:59:31.757 回答