根据细胞vba的值join细胞
如果在该行的单元格中存在一个值,我试图连接一行中的单元格。
数据已经从.txt文件导入,不同的子标题分为2,3或4列。
这些单元格不能合并,因为数据只能从第一个单元格保存。
在B栏中总是保持不变的是“包含”和“为”。
我所尝试过的类似于:
如果cell.Value像“contains”或“ for ”那么将列“A”到列“H”的所有单元格连接到列“B”中,将它们居中alignment并使它们变为粗体。
提前感谢您的帮助。
编辑这里是代码:
Sub Joining() Dim N As Long, i As Long, r1 As Range, r2 As Range Dim z As Long Dim arr() As Variant z = 1 With Activesheet N = .Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To N If .Cells(i, "B").Value Like "Summary*" Then arr = .Range(.Cells(i, "A"), .Cells(i, "H")).Value .Cells(z, "B").Value = Join(arr, " ") z = z + 1 End If Next i End With
结束小组
不知道这是否正是你想要的,但它会让你closures:
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
好吧,我已经创build了一个答案,但它不漂亮(有点像我创build的整个项目)。
它工作,虽然我确信有一个更简单的方式来创build它。
也许有人可以去清理它?
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