Question

如果该行的单元格中存在值，我试图连续加入单元格。

数据已从.txt文件导入，各个子标题按2,3列或4列分割。

单元格无法合并，因为数据只会保留在第一个单元格中。

唯一始终不变的词是B列中的“包含”和“for”。

我尝试过的东西类似于：

如果cell.Value喜欢“包含”或“ for ”，那么将列“A”中的所有单元格连接到列“B”中的列“B”，集中对齐并使它们变粗。

提前感谢您的帮助。

编辑这是代码：

df <- structure(list(x1 = 1:5, x2 = 6:10, y1 = c(1.03645018, -1.10790835, 
0.95452119, 0.01370762, 0.19354354), y2 = c(-0.8602099, 1.6912875, 
2.7232657, 1.6385765, -1.046436)), .Names = c("x1", "x2", "y1", 
"y2"), class = "data.frame", row.names = c("1", "2", "3", "4", "5"))

End Sub

Answer 1

不确定这是否正是您想要的，但它会让您关闭：

Sub summary()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim N As Long, i As Long, r1 As Range, r2 As Range
    Dim z As Long
    Dim arr() As Variant
    z = 1
    Set sh1 = ActiveSheet
    With ActiveWorkbook
        Set sh2 = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
    End With

    With sh1
        N = .Cells(Rows.Count, "A").End(xlUp).Row
        For i = 1 To N
            If .Cells(i, "A").Value Like "Summary*" Then
                arr = .Range(.Cells(i, "A"), .Cells(i, "H")).Value
                sh2.Cells(z, "A").Value = Join(arr, " ")
                z = z + 1
            End If
        Next i
    End With
End Sub

Answer 2

好的，所以我已经创建了一个答案，但它并不漂亮（有点像我创建的整个项目）。

虽然我确信有一种更简单的方法可以创建它，但它仍然有效。

也许有人可以去清理它？

Sub SelRows()

Dim ocell As Range
Dim rng As Range
Dim r2 As Range

For Each ocell In Range("B1:B1000")

    If ocell.Value Like "*contain*" Then

        Set r2 = Intersect(ocell.EntireRow, Columns("A:G"))

        If rng Is Nothing Then

            Set rng = Intersect(ocell.EntireRow, Columns("A:G"))
        Else

            Set rng = Union(rng, r2)
        End If
    End If
Next

Call JoinAndMerge


If Not rng Is Nothing Then rng.Select

Set rng = Nothing
Set ocell = Nothing
End Sub

Private Sub JoinAndMerge()
Dim outputText As String, Rw As Range, cell As Range
delim = " "
Application.ScreenUpdating = False
For Each Rw In Selection.Rows
For Each cell In Rw.Cells
    outputText = outputText & cell.Value & delim
Next cell
With Rw
.Clear
.Cells(1).Value = outputText
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
outputText = ""
Next Rw
Application.ScreenUpdating = True
End Sub

根据单元格vba的值加入单元格

2 个答案: