从数组中合并 Excel 中的单元格答案

【问题标题】：Merging Cells in Excel from an Array从数组中合并 Excel 中的单元格
【发布时间】：2020-01-09 09:04:48
【问题描述】：

这是我要完成的任务：Cell B2：开始日期和Cell B3：结束日期

示例：
B2 --> 2019 年 1 月 1 日
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

我要做的是：从单元格D4开始，将数组arr的第一个值放入其中并合并单元格E4 和 F4 （因此单元格 D4, E4, F4 与值 1 合并），放入数组的下一个值（在这个case Cell G4 和值 2) 并合并右侧的其他 2 个单元格，因此它将是 Cells G4, H4, I4 与value 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

【问题讨论】：

你自己尝试过什么让它发挥作用？无意冒犯，但似乎社区正在为您慢慢构建代码（查看您以前的问题）。你至少应该自己试试。当您遇到问题时，您可以获得有关问题/错误的帮助。
您在尝试自己发布代码时绝不会看起来很愚蠢，当您刚接触 VBA 时当然不会。关于代码，您可以将其放入您的问题中，就像您对其他代码所做的那样。
是的，我现在做到了。希望它可以帮助某人

标签： arrays excel vba merge

【解决方案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

【讨论】：

如果我可以要求更多解释Worksheets(1).Cells.Delete 我可以给它一个单元格范围吗？因为我通常使用.Clear --> 但它不会取消列的宽度（我在列中添加了一些自定义宽度以使其更易于阅读）。
@ChangeWorld - 只是为了重置工作表。一般来说，给出一个范围是可以的 - Worksheets(1).Range("A5:D10").Delete

【解决方案2】：

您实际上不需要使用数组，因为您将 NoOfWeeks 分配为变量；

只需替换您的第一个代码的这一部分...

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

使用此代码...

x = 4

For i = 1 To NoOfWeeks
    With Cells(3, x)
        .Value = i
        .Resize(, 3).Merge
        .HorizontalAlignment = xlCenterAcrossSelection
    End With
    x = x + 3
Next i

【讨论】：