如何在excel中组合折线

Question

我有一个包含数千行的excel表。第一列中的某些行已被破坏。没有虚线总是有相邻的列，其中包含数据。断线不是。换句话说，我如何转换以下内容：

进入这个：

Answer 1

以下是您要遵循的步骤。在执行任何此操作之前，您应该制作电子表格的备份副本。

• 打开Excel电子表格。

• 确保您要处理的工作表是活动工作表

  • 这是确保您拥有原始数据文件备份的好时机。
• 单击文件/选项/自定义功能区
• 在右侧的复选框列表中，如果未选中“制造商”复选框，请将其选中
• 单击[确定]
• 单击“开发者”选项卡
• 双击Visual Basic图标
• 在弹出的窗口中，右键单击当前工作簿名称下的Microsoft Excel Objects条目。然后选择插入 - ＆gt;弹出菜单中的模块。看起来应该是这样的：

• 插入工作簿后，此树看起来更像是这样：

• 您还将有一个子窗口，可能标题为 [工作簿名称] - Module1（代码）。这是放置VBA代码的地方。复制以下代码：

Dim MaxRow As Integer

Sub MergeRows()

Dim Ptr As Integer
Dim I As Integer

ActiveSheet.Cells(1, 1).Activate    ' Move to the first cell
GetMaxRow                           ' Get the last row in the worksheet
ActiveSheet.Cells(1, 1).Activate    ' Move to the first cell

Ptr = 0
I = 0

For I = 1 To MaxRow
    If ActiveSheet.Cells(I, 1).Value > "" Then
        If ActiveSheet.Cells(I, 2).Value > "" Then
            Ptr = I
        Else
            If Ptr > 0 Then ActiveSheet.Cells(Ptr, 1).Value = ActiveSheet.Cells(Ptr, 1).Value & ActiveSheet.Cells(I, 1).Value

            ActiveSheet.Cells(I, 1).Value = ""

        End If
    End If
Next I

End Sub

Sub GetMaxRow()
'
    MaxRow = ActiveCell.SpecialCells(xlLastCell).Row

End Sub

• 将复制的代码粘贴到空的Module1窗口中。
• 点击Dim Ptr As Integer
行
• 按F5
• 等待几秒钟
• 关闭模块。如果要保存代码，则由您决定，但在此工作簿中可能永远不会再需要它。只需保存对此问题的引用...以防万一。
• 关闭 Microsoft Visual Basic for Applications 窗口。
• 验证您的数据。

如果有任何问题，请更新此答案，我会检查出来。

Answer 2

如果我们开始：

并运行这个短宏：

Sub ArchiveWeek()
    Set thisMon = Worksheets("Daily Itemized").Range("F5") 'Assigns variable thisMon as the date value in Daily Itemized Tab, F5 cell

    Dim ws As Excel.Worksheet
    Dim FoundCell As Excel.Range

    Set ws = Worksheets("Daily Summary Record")
    Set FoundCell = ws.Range("D:D").Find(what:=thisMon, lookat:=xlWhole)
    If Not FoundCell Is Nothing Then
        'Copy values from Daily sheet to Summary sheet, commencing
        ' one cell to the right of the location of the date
        FoundCell.Offset(0, 1).Resize(7, 13).Value = _
                    Worksheets("Daily Itemized").Range("G5:S11").Value
        MsgBox ("Your week time values have been pasted!")
    Else
        MsgBox ("The Date of " & thisMon & " was not found in the Daily Summary Record, Column D. Recheck values.")
    End If

我们最终会：

Answer 3

以下是包含您请求的更改的代码块。我决定只更换整个代码块，基于（1）你不知道VBA编码的事实，以及（2）我不知道你实际知道的编码（如果有的话）。对于没有编码经验的人来说，完全替换比编辑更容易。

Dim MaxRow As Integer

Sub MergeRows()

Dim Ptr As Integer
Dim I As Integer

Dim WorkStr As String
Dim S As String
Dim Space As String

ActiveSheet.Cells(1, 1).Activate    ' Move to the first cell
GetMaxRow                           ' Get the last row in the worksheet
ActiveSheet.Cells(1, 1).Activate    ' Move to the first cell

Ptr = 0
I = 0

For I = 1 To MaxRow
    If ActiveSheet.Cells(I, 1).Value > "" Then
        If ActiveSheet.Cells(I, 2).Value > "" Then
            Ptr = I
        Else
            If Ptr > 0 Then
                Space = " "

                WorkStr = ActiveSheet.Cells(Ptr, 1).Value
                S = ActiveSheet.Cells(I, 1).Value

                If Right(WorkStr, 1) = "-" Then
                    WorkStr = Left(WorkStr, Len(WorkStr) - 1)
                    Space = ""
                End If

                If Left(S, 1) = "-" Then
                    S = Right(S, Len(S) - 1)
                    Space = ""
                End If

                ActiveSheet.Cells(Ptr, 1).Value = WorkStr & IIf(Right(WorkStr, 1) = " " Or Left(S, 1) = " ", "", Space) & S

            End If
            ActiveSheet.Cells(I, 1).Value = ""

        End If
    End If
Next I

End Sub

Sub GetMaxRow()
'
    MaxRow = ActiveCell.SpecialCells(xlLastCell).Row

End Sub

Answer 4

SpecialCells()在这里非常方便：

Option Explicit

Sub main()
    Dim cell As Range

    With Range("A1", Cells(Rows.count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues)
        For Each cell In .Offset(, 1).SpecialCells(xlCellTypeBlanks).Offset(, -1)
            With IIf(IsEmpty(cell.Offset(-1)), cell.End(xlUp), cell.Offset(-1))
                .Value = IIf(Right(.Value, 1) = "-", Left(.Value, Len(.Value) - 1), .Value & " ") & cell.Value
            End With
            cell.ClearContents
        Next cell
    End With
End Sub