[英]Loop and concatenate 2 cell value between specific range
I am trying to identify a specific range in column-A and concatenate two cells within the specific range and delete the empty cell. 我正在尝试在A列中标识特定范围,并将特定范围内的两个单元格连接起来,然后删除空单元格。 I have been successful in putting a code together and it does the job very well.
我已经成功地将代码组合在一起,并且可以很好地完成工作。 But, I don't know how to loop it to identify next range.
但是,我不知道如何循环使用它来确定下一个范围。 Any help would be appreciated.
任何帮助,将不胜感激。
As per below image and code, First, I am finding and selecting a range between two (MCS) in column-A with a condition that, if the rows are more than 8 between two MCS. 根据下面的图像和代码,首先,我要找到并选择A列中两个(MCS)之间的范围,条件是,如果两个MCS之间的行数大于8。 Then I am concatenating first 2 cells immediately after MCS and delete the empty row.
然后,我将在MCS之后立即连接前两个单元格,并删除空行。
The below code works well for first range but I am unable to loop to identify next range from row 22 to 32 and perform concatenations. 下面的代码对于第一个范围效果很好,但是我无法循环以标识第22行到第32行的下一个范围并执行串联。 I want to loop in column-A as there will be more MCS.
我想循环进入A列,因为将会有更多的MCS。
Sub MergeStem()
Dim findMCS1 As Long
Dim findMCS2 As Long
Dim myCount As Integer
Dim myStems As Long
Dim mySelect As Range
Dim c As Range
findMCS1 = Range("A:A").Find("MCS", Range("A1")).Row
findMCS2 = Range("A:A").Find("MCS", Range("A" & findMCS1)).Row
myCount = Range("A" & findMCS1 + 1 & ":A" & findMCS2 - 1).Cells.Count
Range("B1").Value = myCount
MsgBox "Number of rows =" & myCount
Set mySelect = Selection
If myCount > 8 Then
myStems = Range("A" & findMCS1 + 2 & ":A" & findMCS2 - 9).Select
Set mySelect = Selection
For Each c In mySelect.Cells
If firstcell = "" Then firstcell = c.Address(bRow, bCol)
sArgs = sArgs + c.Text + " "
c.Value = ""
Next
Range(firstcell).Value = sArgs
End If
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub
You could try: 您可以尝试:
Option Explicit
Sub test()
Dim i As Long, Lastrow As Long, Startpoint As Long, Endpoint As Long, Diff As Long
Dim str As String
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Startpoint = 0
Endpoint = 0
For i = Lastrow To 2 Step -1
str = .Range("A" & i).Value
If str = "MCS" And Startpoint = 0 Then
Startpoint = i
ElseIf str = "MCS" And Startpoint <> 0 Then
Endpoint = i
End If
If Startpoint > 0 And Endpoint > 0 Then
Diff = Startpoint - Endpoint
If Diff > 8 Then
.Range("A" & Endpoint + 1).Value = .Range("A" & Endpoint + 1).Value & " " & .Range("A" & Endpoint + 2).Value
.Rows(Endpoint + 2).EntireRow.Delete
Startpoint = 0
Endpoint = 0
End If
End If
Next i
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.