如何將同年合併在一起

Question

我想從工作表1中抽取兩個日期，並根據月份和年份在工作表2中生成該日期範圍。我有一個代碼可以做到這一點，但我遇到了一些問題，我將在稍後解釋。 This is what my code does（假定工作表1中的2個日期是MM-YY格式的oct-17和mar-18）。

1. 我的主要問題是，我如何得到相同的年份合併在一起？ I want it to look like this.

2. 我遇到的第一個問題是我必須兩次運行宏才能更改年份格式。我能做些什麼來解決這個問題？

3. 第二個問題是有些時候有些月份不能正確顯示，而是會顯示「########」，如第一張附加圖片所示。我注意到這隻發生在自定義日期格式中。爲什麼會發生這種情況，我該如何解決這個問題？

我真的很感謝任何幫助，我可以得到。下面是我的代碼

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 

UPDATE

3。發生這種情況是因爲該列不夠寬。我將格式從「mmmm」更改爲「mmm」，以便生成的月份總是足夠短以適合列內。感謝@ClementB和@PalimPalim！

1。我設法獲得並修改了一個代碼，以合併來自How to merge cells based on similar values - Excel 2010的匹配內容的單元格。現在我需要的是從日期中提取年份，因爲我將日期模糊了，所以2017年和2018年背後的實際值爲2017年1月10日，2017年1月1日等。因此，我不能使用合併類似單元格宏。

我想用所有年份的循環使用DatePart（「yyyy」），但我不知道如何，因爲我仍然是新的excel vb。請協助。

Answer 1

我剛剛在上面的代碼結尾處調用了以下宏。該宏將從日期提取數年，然後將每年同一年的單元合併在一起。有了這個，我設法解決了我的問題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