Question

我想从工作表1中获取2个日期，并在工作表2中按月和年生成该日期范围。我有一个代码可以做到这一点，但我遇到了一些我稍后会解释的问题。 This is what my code does（假设表1中的2个日期是oct-17和MM-YY格式的mar-18）。

我的主要问题是，如何将同一年合并在一起？ I want it to look like this.
我遇到的第一个问题是我必须运行宏两次才能更改年份格式。我该怎么做才能解决这个问题？
第二个问题是，有些月份有些月份无法正确显示，而是显示＆＃34; ########＆＃34;如第一张附图所示。我注意到这只发生在自定义日期格式中。为什么会发生这种情况？我该如何解决这个问题呢？

我真的很感激我能得到的任何帮助。以下是我的代码

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

更新

3。发生这种情况是因为列不够宽。我将格式更改为＆＃34; mmm＆＃34;来自＆＃34; mmmm＆＃34;因此，所得到的月份总是足够短，以适应列内。谢谢@ClementB和@PalimPalim！

1。我设法获取并修改代码以合并来自How to merge cells based on similar values - Excel 2010的匹配内容的单元格。现在我所需要的是从日期中提取年份，因为我将这些年份作为日期，所以2017年和2018年背后的实际值是10/1 / 2017,11 / 1/2017等等。因此，我无法使用合并相似的单元格宏。

我考虑过多年来一直使用DatePart（＆＃34; yyyy＆＃34;），但我不确定我是如何继续使用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

如何将同一年合并在一起

1 个答案: