设置一个范围，取决于单元格的值，然后合并。

huangapple
go评论112阅读模式
英文:

Set a range depends on the cells values and then merge

问题

我在第一行找到了一个或多个连续的单元格，其值为 Attach*。
我需要为这些单元格设置一个范围，然后进行合并。
下面的代码可能有效，但它并不可靠，因为可能出现以下情况：
1- 如果只找到一个值为 Attach* 的单元格，则会将其与右侧的所有单元格合并（即使是空白的）。
2- 或者有两个或更多值为 Attach* 的单元格，但它们右侧有非空白单元格。

  1. Sub Set_range_depends_on_values()
  3.     Dim ws As Worksheet: Set ws = ActiveSheet
  4.     Dim rngStart As Range
  6.     Set rngStart = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
  7.               LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
  8.               SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
  10.     If rngStart Is Nothing Then MsgBox "No cells with value Attach*": Exit Sub
  12.     Set rngStart = ws.Range(rngStart, rngStart.End(xlToRight))
  14.     rngStart.Merge
  16.     rngStart.Select   'just to see the result
  18. 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.

  1. Sub Set_range_depends_on_values()
  3.     Dim ws As Worksheet:  Set ws = ActiveSheet
  4.     
  5.     Dim rngStart As Range
  6.     
  7.     Set rngStart = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
  8.               LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
  9.               SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
  10.               
  11.     If rngStart Is Nothing Then MsgBox "No cells with value Attach*": Exit Sub
  12.               
  13.     Set rngStart = ws.Range(rngStart, rngStart.End(xlToRight))
  14.     
  15.     rngStart.Merge
  16.     
  17.     rngStart.Select   'just to see the result
  19. End Sub

设置一个范围，取决于单元格的值，然后合并。

设置一个范围，取决于单元格的值，然后合并。

答案1

得分: 3

以下是翻译好的代码部分：

  1. Sub Set_range_depends_on_values()
  3.     Dim ws As Worksheet: Set ws = ActiveSheet
  4.     
  5.     Dim rngStart As Range
  6.     
  7.     Set rngStart = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
  8.               LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
  9.               SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
  10.               
  11.     Set rngStop = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
  12.               LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
  13.               SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
  14.           
  15.     If rngStart Is Nothing Then MsgBox "No cells with value Attach*": Exit Sub
  16.               
  17.     Set rngStart = ws.Range(rngStart, rngStop)
  18.     
  19.     rngStart.Merge
  20.     
  21.     rngStart.Select   'just to see the result
  23. End Sub

希望这对您有所帮助。

英文:

This added lines will do

  1. Sub Set_range_depends_on_values()
  3.     Dim ws As Worksheet:  Set ws = ActiveSheet
  4.     
  5.     Dim rngStart As Range
  6.     
  7.     Set rngStart = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
  8.               LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
  9.               SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
  10.         Set rngStop = ws.Rows(1).Find(What:="Attach*", After:=Range("A1"), _
  11.               LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
  12.               SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
  13.           
  14.     If rngStart Is Nothing Then MsgBox "No cells with value Attach*": Exit Sub
  15.               
  16.     Set rngStart = ws.Range(rngStart, rngStop)
  17.     
  18.     rngStart.Merge
  19.     
  20.     rngStart.Select   'just to see the result
  22. End Sub

huangapple
  • 本文由 发表于 2023年6月8日 14:01:55
  • 转载请务必保留本文链接：https://go.coder-hub.com/76429000.html
  • excel
  • range
  • vba
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定