Vba 如何将相同的年份合并在一起

我想从表1中选取2个日期，并在表2中以月和年为单位生成该日期范围。我有一个这样做的代码，但我遇到了一些问题，我将在后面解释。（假设表1中的两个日期为10月17日和3月18日，采用MM-YY格式）

我的主要问题是，我如何让相同的年份合并在一起

我遇到的第一个问题是，我必须运行宏两次，以改变格式。我能做些什么来解决这个问题

第二个问题是，某些月份有时无法正确显示，反而会显示“########”，如第一张附图所示。我注意到这只发生在自定义日期格式中。为什么会发生这种情况？我如何解决

如果能得到任何帮助，我将不胜感激。下面是我的代码

Sub macro3Planning()

Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Sheets(1)
Set ws2 = Sheets(2)

Dim rng As Range
Set rng = ws2.Range("B3").Offset(3, 8)

Dim StartDate As Date
Dim EndDate As Date
Dim NoDays As Integer  

StartDate = ws1.Range("D6").Value
EndDate = ws1.Range("D7").Value
NoDays = EndDate - StartDate + 1

'Generates months
With rng
    .Value = StartDate
    .Resize(NoDays).DataSeries Rowcol:=xlRows, Type:=xlChronological, Date:= _
    xlMonth, Step:=1, Stop:=EndDate, Trend:=False       
    .VerticalAlignment = xlTop
    .HorizontalAlignment = xlCenter
    .Font.Bold = True
    .Borders.LineStyle = xlContinuous
    .NumberFormat = "mmm"
    .Interior.Pattern = xlSolid
    .Interior.ThemeColor = xlThemeColorDark1
    .Interior.TintAndShade = -0.149998474074526
End With

Set rng = rng.Offset(-1)

'Generates year
With rng
    .Value = StartDate
    .Resize(NoDays).DataSeries Rowcol:=xlRows, Type:=xlChronological, Date:= _
    xlMonth, Step:=1, Stop:=EndDate, Trend:=False       
    .VerticalAlignment = xlTop
    .HorizontalAlignment = xlCenter
    .Font.Bold = True
    .Borders.LineStyle = xlContinuous
    .NumberFormat = "yyyy"
    .Interior.Pattern = xlSolid
    .Interior.ThemeColor = xlThemeColorAccent2
    .Interior.TintAndShade = 0.599993896298105
End With

End Sub

更新

三,。这是因为列不够宽。我将格式从“mmmm”改为“mmm”，这样得到的月份总是足够短，可以放在列中。谢谢@ClementB和@PalimPalim

一,。我设法获得并修改了一个代码，以便将单元格与来自的匹配内容合并。现在我需要的是从日期中提取年份，因为我将年份定为日期，所以这些2017年和2018年的实际值是2017年1月10日、2017年1月11日，依此类推。因此，我还不能使用“合并相似单元格”宏

---

多年来，我一直在考虑使用DatePart（“yyyy”）和循环，但我不确定如何使用，因为我对excel vb还是新手。请协助。

我刚刚在上述代码末尾调用了以下宏。宏从日期中提取年份，然后将具有相同年份的每个单元格合并在一起。有了这个，我设法解决了我的问题1和2。似乎只是一个简单任务的长代码

Sub mergesameyears()

Dim lastCol As Integer
lastCol = Cells.Find("*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Column

Dim tosubtract As Integer
'9 is the column J number
tosubtract = 9

'Number of generated years
Dim noyears As Integer
noyears = lastCol - tosubtract

Dim selectyear As Integer

'Set rng to J5 which is first generated year
Dim rng As Range
Set rng = Range("J5")

Dim yearvalue As Integer
Dim asd As Long

For selectyear = 1 To noyears Step 1
    asd = rng.Value
    yearvalue = DatePart("yyyy", asd)
    rng.Clear
    rng.Value = yearvalue
    Set rng = rng.Offset(0, 1)
Next selectyear

Application.DisplayAlerts = False

Dim lastColumn As Range
Set lastColumn = Cells.Find("*", SearchOrder:=xlByRows,     Searchdirection:=xlPrevious)

Dim mergesame As Range, cell As Range
Set mergesame = Range("J5", lastColumn.Offset(-1))

Merge:
    For Each cell In mergesame
        If cell.Value = cell.Offset(, 1).Value And IsEmpty(cell) = False     Then
            With Range(cell, cell.Offset(, 1))
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlTop
                .Font.Bold = True
                .Borders.LineStyle = xlContinuous
                .Interior.Pattern = xlSolid
                .Interior.ThemeColor = xlThemeColorAccent2
                .Interior.TintAndShade = 0.599993896298105
            End With
            GoTo Merge
        End If
    Next

Application.DisplayAlerts = True

End Sub

---

1） 您只需要将年份与这个：Range（“J5:L5”）.merge合并。要知道您需要在L5停止，您只需要在之前使用一个简单的循环进行迭代。2） 使用CDate（Format（target.Value，“dd/mm/yyyy”））3）我很确定这是因为列不大，而第二个问题是因为列不够宽。例如，如果你改变K列的宽度，日期应该是清晰可见的。今天早些时候在这里提出了几乎完全相同的问题。谢谢克莱门特和帕林帕林回答我的第三个问题。我没意识到解决办法这么简单！关于@Rik Sportel的链接，我的年份范围实际上是日期，但格式仅显示YYYY。因此，实际值仍在日期中，例如，2017年10月1日、2017年11月1日等。作为旁注，####仅适用于数值。您可以使用

.Text

而不是

.Value

来获取单元格中显示的文本，而不是单元格值