Question

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

CENTRUM ADVANCE TABLET应仅复制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

我认为你需要做出一些改变：

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 2

使用拆分功能，示例

Z.succ

Split Function (Visual Basic)

<强> 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

Split (text_string, delimiter, limit, compare) text_string: 。

C.Value 分隔符是空格字符（＆＃34;＆＃34;）。

delimiter: 将limit:参数留空，因为我们需要将limit中的所有字词分开。

C.Value 这将为空白，因为空白指定二进制比较方法。

Answer 3

尝试这样的事情

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

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

3 个答案: