Question

我有一个代码

1）比较X列到Y列的日期。

2）如果列之间不匹配，则将日期粘贴到Y列。

第X列，我的格式如下

08/15/2013
09/12/2013
10/03/2013

但是当它粘贴到Y列时，它就会消失

15/08/2013
12/09/2013
03/10/2013

如何格式化粘贴格式，使其变为dd / mm / yyyy。

添加了更多代码以显示数组：

   ReDim PasteArr(1 To 1, 1 To 6)
    subcount = 1

    For Cell1 = 1 To UBound(DataArr(), 1)
        For Each Cell2 In BusDates()
            If DataArr(Cell1, 1) Like Cell2 Then
                Matched = True
                Exit For                                      'if it matches it will exit
            ElseIf Cell2 Like BusDates(UBound(BusDates), 1) Then 'if it gets to the end, it's truly unique and needs to be added

                For index = 1 To 6
                    PasteArr(subcount, index) = DataArr(Cell1, index)
                Next index

                subcount = subcount + 1

                PasteArr = Application.Transpose(PasteArr)
                ReDim Preserve PasteArr(1 To 6, 1 To subcount)
                PasteArr = Application.Transpose(PasteArr)

                Matched = False

            End If
        Next Cell2

        If Matched = False Then
            BusDates = Application.Transpose(BusDates)
            ReDim Preserve BusDates(1 To UBound(BusDates) + 1)
            BusDates = Application.Transpose(BusDates)
            BusDates(UBound(BusDates), 1) = DataArr(Cell1, 1)
        End If

    Next Cell1
    Worksheets("stacks").Range("M" & LastRow + 1 & ":" & Cells(LastRow + UBound(PasteArr, 1) - 1, 18).Address).Value = PasteArr

我尝试过的方法：更改单元格的格式

15/08/2013
12/09/2013
03/10/2013

现在是X列的正确格式。

但这会粘贴到Y列中：

是

15/08/2013 - correct
09/12/2013 - incorrect
10/03/2013 - incorrect.

Answer 1

使用dd/MM/yyyy作为单元格格式。小写的m代表分钟，大写的M代表几个月。

Answer 2

检查您的单元格格式。应该是：

Number
  Custom
    dd/mm/yyyy (depending on your locale, in my case (Dutch) it's dd/mm/jjjj)

Answer 3

根据我上面的评论，假设您正在使用数组，而不是直接复制范围/单元格。如果将数组声明为字符串数组，则会出现转置天数/月数的问题。例如：

可能是问题吗？

Answer 4

我住在葡萄牙，有时我在日期格式选项方面也遇到同样的问题。通常，我所做的（通常是可行的）是使用和滥用DateSerial函数。例如，如果我想填充您的PasteArr数组，我会这样做：

PasteArr(subcount, index) = DateSerial(Year(DataArr(Cell1, index)), Month(DataArr(Cell1, index)), Day(DataArr(Cell1, index)))

要在单元格上写日期，请执行以下操作：

Worksheets("stacks").cells("M" & LastRow + 1).formulaR1C1 = DateSerial(Year(PasteArr(subcount, index)), Month(PasteArr(subcount, index)), Day(PasteArr(subcount, index)))

诚实，以前的过程似乎有点愚蠢。确实如此！但是，它可以解决日期格式dd/mm/yyyy和mm/dd/yyyy的问题。如果您问我为什么，我不知道它是如何工作的！但这每次都有效！

Answer 5

技巧是使用Range.value属性将值从列X分配到列Y。这将确保以与X列中相同的格式（无论日期，数字，字符串等）传输数据。如果在两列上设置相同的显示，则在两列上都会看到相同的内容。

我发现您的代码很复杂，所以我重写了搜索第一列“ X”的逻辑，并将唯一出现的内容放在第二列“ Y”

Public Sub findOrAdd()
    Const COLUMN_SOURCE = "B"
    Const COLUMN_DEST = "D"
    Const ROW_STARTDATA = 2

    Dim x As Long, y As Long
    Dim foundMatch As Boolean

    Dim sht As Worksheet
    Set sht = Sheet1

    x = ROW_STARTDATA
    Do Until sht.Range(COLUMN_SOURCE & x).Value = "" 'X -variable loop walks through all cells in source column
        Debug.Print "Doing row " & x & " =" & sht.Range(COLUMN_SOURCE & x).Value
        foundMatch = False
        'search for value of current cell in destcells
        y = ROW_STARTDATA
        Do Until sht.Range(COLUMN_DEST & y).Value = "" 'Y -variable loop walks through all cells in dest column - checking if it exists
            If sht.Range(COLUMN_SOURCE & x).Value = sht.Range(COLUMN_DEST & y).Value Then
                'match found stop searching and do nothing
                foundMatch = True
                Exit Do
            End If
            y = y + 1
        Loop

        If foundMatch = False Then
            'Y loop completed and match was not found.
            'Append content as end of destination cells
            sht.Range(COLUMN_DEST & y).Value = sht.Range(COLUMN_SOURCE & x).Value

            '** NOTE value is added by assigned cell.value, which is not pasting.
            '** If the formats of the source and destination address are done the same then they will display the same thing in excel
        End If
        x = x + 1
    Loop
End Sub

注意：空白行将导致循环退出

VBA，日期格式问题

5 个答案: