VBA 转发值未被 Excel 识别

Question

所以我有一个 VBA 宏，可以让我像用户窗体一样使用单元格。

它基本上做的是，它采用定义的 Range("E2:E11") 的 Values 并将它们转置到下一个 BlankRow。

因此，用户可以轻松生成范围为 C16:L100

的矩阵

VBA 代码如下所示：

Sub NeuesKFZ()
 Dim sh As Worksheet, arr, lastERow As Long, matchCel As Range
 
 Set sh = ActiveSheet
 arr = sh.Range("E2:E11").Value
 lastERow = sh.Range("C" & sh.Rows.Count).End(xlUp).Row + 1
 
 If Range("E2") = "" Then
        MsgBox "Wählen Sie ein KFZ aus!"
        Range("E2").Select
    Exit Sub
End If
 
If lastERow < 16 Then lastERow = 16
 'check if the range has not been already copied:
 Set matchCel = sh.Range("C16:C" & lastERow - 1).Find(WHAT:=sh.Range("E2").Value, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
 
 If Not matchCel Is Nothing Then
    If MsgBox(sh.Range("E2").Value & " Existiert bereits " & vbCrLf & "Sollen die Daten aktualisiert werden?", vbYesNo) = vbYes Then
         sh.Range("C" & matchCel.Row).Resize(1, UBound(arr)).Value = Application.Transpose(arr)
    End If
    
    sh.Range("E2:E11").ClearContents
    
    Exit Sub

End If
 
 sh.Range("C" & lastERow).Resize(1, UBound(arr)).Value = Application.Transpose(arr)
 sh.Range("E2:E11").ClearContents

End Sub

我现在的问题是 excel 似乎不知道什么样的 values 被转移到新的细胞中。

在我的例子中，我正在使用日期，我想知道日期是否在接下来的三个月内。但是 Excel 无法识别它正在处理日期值。尝试格式化或删除所有格式都无济于事。

当我尝试使用这个公式时：

=if(and(C16>=$AA16$,C16<=$AB),TRUE,FALSE)

一些解释：

C16 是被宏转置的值。

AA16和AB16是开始日期和结束日期。

TRUE 和 FALSE 只是为了给我反馈是否有效。

它一直给我 FALSE。

有没有办法让日期转置以便 Excel 仍然知道它是一个日期？或者强制 Excel 将这些值作为日期处理。

Answer 1

转置列

我想我在某处读到除了大小限制之外，Transpose“不喜欢”日期。无论如何，对您的代码进行以下更正并将函数复制到工作簿的标准模块中。

更正

替换arr = sh.Range("E2:E11").Value
arr = GetRowData(sh.Range("E2:E11")).
替换sh.Range("C" & matchCel.Row).Resize(1, UBound(arr)).Value = Application.Transpose(arr)
sh.Range("C" & matchCel.Row).Resize(1, UBound(arr, 2)).Value = arr.
替换sh.Range("C" & lastERow).Resize(1, UBound(arr)).Value = Application.Transpose(arr)
sh.Range("C" & lastERow).Resize(1, UBound(arr, 2)).Value = arr

函数

Function GetRowData( _
    ByVal ColumnRange As Range) _
As Variant

    If ColumnRange Is Nothing Then Exit Function
    
    With ColumnRange.Columns(1)
        
        Dim rCount As Long: rCount = .Rows.Count
        
        Dim rData As Variant
        
        If rCount = 1 Then
            ReDim rData(1 To 1, 1 To 1): rData(1, 1) = .Value
        Else
            Dim cData As Variant: cData = .Value
            ReDim rData(1 To 1, 1 To rCount)
            Dim r As Long
            For r = 1 To rCount
                rData(1, r) = cData(r, 1)
            Next r
        End If
        
        GetRowData = rData
    
    End With

End Function

编辑

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns a 2D one-based one-row array containing the values
'               from a one-column range.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetRowFromColumn( _
    ByVal ColumnRange As Range) _
As Variant
    If ColumnRange Is Nothing Then Exit Function
    With ColumnRange.Columns(1)
        Dim rCount As Long: rCount = .Rows.Count
        Dim rData As Variant
        If rCount = 1 Then
            ReDim rData(1 To 1, 1 To 1): rData(1, 1) = .Value
        Else
            Dim cData As Variant: cData = .Value
            ReDim rData(1 To 1, 1 To rCount)
            Dim r As Long
            For r = 1 To rCount
                rData(1, r) = cData(r, 1)
            Next r
        End If
        GetRowFromColumn = rData
    End With
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns a 2D one-based one-column array containing the values
'               from a one-row range.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetColumnFromRow( _
    ByVal RowRange As Range) _
As Variant
    If RowRange Is Nothing Then Exit Function
    With RowRange.Rows(1)
        Dim cCount As Long: cCount = .Columns.Count
        Dim cData As Variant
        If cCount = 1 Then
            ReDim cData(1 To 1, 1 To 1): cData(1, 1) = .Value
        Else
            Dim rData As Variant: rData = .Value
            ReDim cData(1 To cCount, 1 To 1)
            Dim c As Long
            For c = 1 To cCount
                cData(c, 1) = rData(1, c)
            Next c
        End If
        GetColumnFromRow = cData
    End With
End Function

VBA 转发值未被 Excel 识别

VBA transponded Values not getting recognized by Excel

excel

formatting

vba

转置列

编辑