在循环中选择与非空白单元格相邻的单元格答案

【问题标题】：Selecting cells adjacent to non-blank cells within a loop在循环中选择与非空白单元格相邻的单元格
【发布时间】：2016-10-31 15:48:53
【问题描述】：

我正在 Excel 中创建航空公司时间表。它需要看起来像这样：

不幸的是，这些非空白单元格中的文本不会与相邻单元格重叠，因为相邻的“空白”单元格中都有公式（即使公式的值为“”）。请注意，每一列代表一小时的时间。因此，我的电子表格看起来像这样：

我相信创建我想要的外观的唯一方法是编写一个宏。对于所示的八行中的每一行，该过程将遍历每一列并识别非空白单元格。然后对于所有此类非空白单元格，如果单元格代表航班起飞（例如，从蓝色的 WUH 出发 - 我可以为此创建一个测试，例如它左侧的单元格是否为空白），我需要选择该单元格并右侧的四个单元格，然后合并并左对齐。如果单元格代表航班到达（例如红色的 WUH 或 MCO），我需要选择单元格，将其内容的仅值复制到其左侧的单元格 4，然后选择该单元格和右侧的四个单元格，然后合并并右对齐。

由于我是 VBA 的新手，有人可以帮我处理这段代码吗？我最需要帮助的部分是在循环过程中选择与非空白单元格相邻的一系列单元格。请注意，我也是 Stack Overflow 的新手，所以如果我未能正确提出问题，请告诉我。

【问题讨论】：

欢迎来到 StackOverflow。请注意，这不是免费的代码编写服务，但我们渴望帮助其他程序员（和有志者）编写自己的代码。请阅读How To Ask a Good Question 上的帮助主题。之后，请使用您迄今为止编写的 VBA 代码更新您的问题，以完成您希望完成的任务。
我认为您不需要 VBA，它不能解决您想要查看的单元格旁边的单元格不为空的问题。而是将带有公式的单元格移动到其他地方，也许是隐藏列。
您可以先录制一个复制您描述的步骤的宏。
感谢您的 cmets。我将尝试使用隐藏列 - 感谢您的建议。我曾尝试录制宏，但我认为在 VBA 中我仍然需要一个循环，以便格式能够响应计划更改。如果我走 VBA 路线，我将发布我的代码。再次感谢。

标签： excel vba

【解决方案1】：

仅供参考，我用以下宏解决了我的问题：

Sub FormatRotation()

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim c As Integer
Dim r As Integer

For c = 4 To 362
'Test if column contains an arrival
    If Len(Cells(9, c).Text) > 2 And Cells(9, c + 1) = "" Then
       For r = 9 To 16
            Cells(r, c).Select
            Selection.Copy
            Cells(r, c - 4).Select
            Selection.PasteSpecial Paste:=xlValues
        Next r
        For r = 9 To 16
            Range(Cells(r, c - 4), Cells(r, c)).Select
                With Selection
                .MergeCells = True
                .HorizontalAlignment = xlRight
                End With
        Next r

    End If

'Test if column contains a departure
    If Len(Cells(9, c).Text) > 2 And Cells(9, c + 1) <> "" Then
        For r = 9 To 16
            Range(Cells(r, c), Cells(r, c + 4)).Select
                With Selection
                .MergeCells = True
                .HorizontalAlignment = xlLeft
                End With
        Next r
    End If


Next c

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Calculate

End Sub

【讨论】：