[英]Excel VBA: If cell contains certain text then input range of cells with that content
Would like to have a column range searched for specific text ("REASON") and when found, have that entire cell content be filled onto a range of different cells. 希望在列范围内搜索特定文本(“原因”),并在找到时将整个单元格内容填充到一系列不同的单元格中。
This is done until a new "REASON" is found - in which case this cell content will be copied accordingly like before. 完成此操作,直到找到新的“ REASON”为止-在这种情况下,此单元格内容将像以前一样被复制。
This is before result: before 这是之前的结果: 之前
... and expected result, with filled text in J column ...和预期结果,在J列中填充文本
Thanks guys, been messing with this but not sure where to go from here: 谢谢大家,一直在弄弄这个,但不知道从这里去哪里:
Sub AddSus()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
If InStr(1, cel.Value, "REASON") > 0 Then
cel.Offset(1, 0).Value = cel.Value
End If
Next cel
End Sub
Use FIND to quickly jump between instances of REASON : 使用FIND在REASON实例之间快速跳转:
Sub AddSus()
Dim SrchRng As Range
Dim rFound As Range
Dim lStart As Long, lEnd As Long
Dim sFirstAddress As String
Dim sReason As String
Set SrchRng = ThisWorkbook.Worksheets("Sheet1").Range("G:G")
'Find the first instance of REASON in column G.
Set rFound = SrchRng.Find(What:="REASON:", _
After:=SrchRng.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
'Check something has been found before continuing.
If Not rFound Is Nothing Then
'Find just keeps looping unless you tell it to stop,
'so record the first found address.
sFirstAddress = rFound.Address
Do
'Save the reason and start row.
sReason = rFound.Value
lStart = rFound.Row
'Find the next REASON in column G.
Set rFound = SrchRng.FindNext(rFound)
If rFound.Address = sFirstAddress Then
'The first instance has been found again, so use column I to find last row of data.
lEnd = SrchRng.Offset(, 2).Cells(Rows.Count, 1).End(xlUp).Row
Else
lEnd = rFound.Row
End If
'Fill in from 2 rows down from Start and 2 rows up from End.
'This will go wrong if there's not enough space between REASONs.
With ThisWorkbook.Worksheets("Sheet1")
.Range(.Cells(lStart + 2, 10), .Cells(lEnd - 2, 10)) = sReason
End With
Loop While rFound.Address <> sFirstAddress
End If
End Sub
There's a few things wrong with this. 这有一些问题。 As you iterate through
cel in SrchRng
your conditional is checking the value of that cel to contain "REASON". 当您
cel in SrchRng
遍历cel in SrchRng
您的条件正在检查该cel的值以包含“ REASON”。 This is not what you want. 这不是您想要的。 What you are essentially doing is checking for the "REASON" string and saying all entries below this, until the next reason, should be true for a conditional to populate column J.
实际上,您要做的是检查“ REASON”字符串,并说出下面的所有条目,直到下一个原因,对于有条件填充列J的条件都应该为true。
Lets, really briefly, run through the logic of a single cell to illustrate why your code was not doing what you wanted: In cell G3, you check to see if it contains the "REASON" string. 让我们, 真的很简单,通过一个单一的单元的逻辑运行,说明为什么你的代码是不是做你想要的:在单元格G3,你检查,看它是否包含了“理性”的字符串。 It does not, so there is no assignment of any value anywhere.
它没有,所以在任何地方都没有赋值。 The following will do what you want:
以下将执行您想要的操作:
Sub AddSus()
Dim SrchRng As Range, cel As Range, reasonString As String
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
If InStr(1, cel.Value, "REASON") > 0 Then
reasonString = cel.Value
ElseIf cel.Value <> "" Then
cel.Offset(0, 3).Value = reasonString
End If
Next cel
End Sub
Minor note but if you are in column G and you want to populate column J, the offset should be .offSet(0,3)
. 次要注意事项,但是如果您在G列中并且要填充J列,则偏移量应为
.offSet(0,3)
。
A Quick and Dirty Solution... 快速而肮脏的解决方案...
Sub AddSus()
Dim SrchRng As Range, cel As Range
Dim reason As String
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
If InStr(1, cel.Value, "REASON") > 0 Then
reason = cel.Value
End If
If cel.Column = 10 And Len(cel.Offset(,-1)) > 0 Then
cel.Value = reason
End If
Next
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.