英文:
Set a range depends on the cells values and then merge
问题
我在第一行找到了一个或多个连续的单元格，其值为 Attach*。
我需要为这些单元格设置一个范围，然后进行合并。
下面的代码可能有效，但它并不可靠，因为可能出现以下情况：
1- 如果只找到一个值为 Attach* 的单元格，则会将其与右侧的所有单元格合并（即使是空白的）。
2- 或者有两个或更多值为 Attach* 的单元格，但它们右侧有非空白单元格。
Sub Set_range_depends_on_values()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim rngStart As Range
Set rngStart = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If rngStart Is Nothing Then MsgBox "No cells with value Attach*": Exit Sub
Set rngStart = ws.Range(rngStart, rngStart.End(xlToRight))
rngStart.Merge
rngStart.Select 'just to see the result
End Sub
英文:
I have a contiguous cell(s) found on the first row with values Attach*.
I need to set a range for this cell(s) and then merge.
the below code may work but it is unreliable at all, because these cases can occur:
1- if only one cell found with value Attach* then it will merge it with all cells on the right side (even blank ones),
2- or there are two cells or more with value Attach*, but there are un-blank cells on the right side of them.
Sub Set_range_depends_on_values()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim rngStart As Range
Set rngStart = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If rngStart Is Nothing Then MsgBox "No cells with value Attach*": Exit Sub
Set rngStart = ws.Range(rngStart, rngStart.End(xlToRight))
rngStart.Merge
rngStart.Select 'just to see the result
End Sub
答案1
得分: 3
以下是翻译好的代码部分：
Sub Set_range_depends_on_values()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim rngStart As Range
Set rngStart = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Set rngStop = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
If rngStart Is Nothing Then MsgBox "No cells with value Attach*": Exit Sub
Set rngStart = ws.Range(rngStart, rngStop)
rngStart.Merge
rngStart.Select 'just to see the result
End Sub
希望这对您有所帮助。
英文:
This added lines will do
Sub Set_range_depends_on_values()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim rngStart As Range
Set rngStart = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Set rngStop = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
If rngStart Is Nothing Then MsgBox "No cells with value Attach*": Exit Sub
Set rngStart = ws.Range(rngStart, rngStop)
rngStart.Merge
rngStart.Select 'just to see the result
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论