arrays - 从数组中合并 Excel 中的单元格

Question

这是我要完成的工作: 单元格 B2:开始日期 和 单元格 B3:结束日期

例子:
B2 --> 01/01/2019
B3 --> 01/03/2019



我有一个数组，其中包含这两个日期之间的周数。示例数组 (1, 2, 3, 4, 5, 6, 7, 8, 9)，包括 2 月的最后一周(第 9 周)。我正在做一个规划 excel 这就是为什么我也在考虑 第 9 周 (我们在上一篇文章中遇到了一些问题，这就是我解释它的原因)

这是我获取此数组的代码

Sub FillCal()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim StartDate As Range, EndDate As Range
Dim NoOfWeeks As Long
Dim arr As Variant
Dim i As Long

With Worksheets("Foglio1")
    Set StartDate = .Range("B2")
    Set EndDate = .Range("B3")
End With

NoOfWeeks = WorksheetFunction.RoundUp((EndDate.Value2 - StartDate.Value2) / 7, 0)

ReDim arr(1 To NoOfWeeks)
For i = 1 To NoOfWeeks
    arr(i) = i
Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

我要做的是:从 Cell D4 开始，将数组的第一个值 arr 放入其中并合并单元格 E4 和 F4 与它(因此单元格 D4、E4、F4 与值合并 1 )，放入数组的下一个值(在这种情况下单元格 G4 和值 2 )并合并右侧的其他 2 个单元格，因此它将是单元格 G4、H4、I4 ，其值为 2 等等。 .. 直到数组的最后一个值(抱歉英语不好，我会附上一张照片以便更好地理解)

这是我想获得的输出:



所以它基本上是:每 3 个单元格合并一次。

由于用户要求它，这就是我尝试合并的方式......

i = wks.Range("A3").End(xlToRight).Row
Set rngMerge = wks.Range("A3:XZ3" & i) ' Find last row in column A

With wks

checkAgain:
For Each rngCell In rngMerge

    If rngCell.Value = rngCell.Offset(0, 1).Value And IsEmpty(rngCell) =        False Then

        Range(rngCell, rngCell.Offset(0, 1)).Merge
        rngCell.VerticalAlignment = xlCenter
        rngCell.HorizontalAlignment = xlCenter
        rngCell.BorderAround ColorIndex:=1

        GoTo checkAgain
    End If

Next
End With

Answer 1

从 D4 开始作为“给定”，只要数组中有东西，指向并合并任何 3 个单元格，这就是我设法构建的:



这是代码:

Sub TestMe()

    Worksheets(1).Cells.Delete

    Dim myCellToStart As Range
    Set myCellToStart = Worksheets(1).Range("D4")

    Dim myArray As Variant
    myArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)

    Dim myVar As Variant
    Dim myCell As Range
    Set myCell = myCellToStart

    For Each myVar In myArray

        Set myCell = Worksheets(1).Range(myCell, myCell.Offset(, 2))

        myCell.Merge
        BorderMe myCell
        myCell = myVar

        Set myCell = myCell.Offset(, 1)

    Next myVar

End Sub

“技巧”是正确定义要合并的范围。用 Set myCell = Worksheets(1).Range(myCell, myCell.Offset(, 2))进行和 Set myCell = myCell.Offset(, 1)来标记新的开始。

这是“边界”功能:

Public Sub BorderMe(myRange As Range)

    Dim cnt As Long

    For cnt = 7 To 10 '7 to 10 are the magic numbers for xlEdgeLeft etc
        With myRange.Borders(cnt)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
    Next

End Sub