根据条件将单元格复制并粘贴到下一列

Question

我正在尝试粘贴单元格内容，条件是如果没有匹配项，则复制单元格的第一个单词并将其粘贴到右侧的下一个单元格，但它给了我对象未定义错误。

CENTRUM

ADVANCE 平板电脑应仅复制 CENTRUM

下面是我的代码

Sub splitUpRegexPattern()
Dim re As Object, c As Range
Dim allMatches
Dim cell As Object
Dim count As Integer
count = 0
For Each cell In Selection
    count = count + 1
Next cell
' MsgBox count & " item(s) selected"
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "((d+(?:.d+)?)s*(m?g|mcg|ml|IU|MIU|mgs|µg|gm|microg|microgram)b)"
re.IgnoreCase = True
re.Global = True
For Each c In ActiveSheet.Range("D2", ActiveSheet.Range("D2").End(xlDown)).Cells ' Select the range and run the code
    Set allMatches = re.Execute(c.Value)
    If allMatches.count > 0 Then
        c.Offset(0, 1).Value = allMatches(0)
    Else
        Selection.Copy
        c.Offset(0, 1).Value.Paste
    End If
Next c
End Sub

Answer 1

使用拆分函数，示例

Set allMatches = re.Execute(c.Value)
If allMatches.count > 0 Then
    c.Offset(0, 1).Value = allMatches(0)
Else
    c.Offset(0, 1).Value = Split(c.Value, " ")(0)
End If

拆分功能(Visual Basic(

Split (text_string, delimiter, limit, compare)

text_string:会C.Value.

delimiter:分隔符将是空格字符 (" "(。

limit:将limit参数留空，因为我们需要将所有单词与C.Value分开。

compare: 这将是空白的，因为空白指定二进制比较方法。

Answer 2

我认为您需要进行一些更改：

c.Copy
c.Offset(0, 1).PasteSpecial

没有值的粘贴属性。 c 是一个范围，因此它具有复制和粘贴方法。

对于您的其他问题：

Dim LArray() As String
LArray = Split(c.Text, " ")
c.Offset(0, 1).Item(1, 1).Value = LArray(0)

Answer 3

尝试这样的事情

Else
    Selection.Copy
    Selection.Offset(1, 0).Select
    ActiveSheet.Paste
End If