Question

我有一张Excel表格，其中包含以下内容：

我参与了一个宏，它有以下几点： -

找到包含标题ABC {DONE}

如果声明，检查在拆分发生之前列标题AB是否已存在。的 {PENDING}

在ABC旁边插入十个新列，名称为AB和CD ......等 {DONE}
然后将ABC细胞内容分成AB和CD的各个细胞;通过将前两个字符与相应的列标题匹配（ABC列可能有一个内容具有相似的前两个字符） {PENDING}
按照步骤（3）直到列ABC内容结束。的 {DONE}

我写了以下代码： -

    Option Explicit

    Sub NumFormat()

       Dim colNum As Integer
    colNum = ActiveSheet.Rows(1).Find(what:="ABC", lookat:=xlWhole).Column

        'insert two columns
        ActiveSheet.Columns(colNum + 1).Insert
        ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ' New col headings
    ActiveSheet.Cells(1, colNum + 1).Value = "AB"
    ActiveSheet.Cells(1, colNum + 2).Value = "CD"
    ActiveSheet.Cells(1, colNum + 3).Value = "EF"
    ActiveSheet.Cells(1, colNum + 4).Value = "GH"
    ActiveSheet.Cells(1, colNum + 5).Value = "IJ"
    ActiveSheet.Cells(1, colNum + 6).Value = "KL"
    ActiveSheet.Cells(1, colNum + 7).Value = "MN"
        Dim colRange As Range
    With ActiveSheet
        Set colRange = .Range(.Cells(2, colNum), .Cells(.UsedRange.Rows.Count, colNum))
    End With

    Dim splitStr() As String

Dim vcell As Range
For Each vcell In colRange
    splitStr = Split(vcell.Value, vbLf)
    For Each s In splitStr
        Set cel = ActiveSheet.Cells(vcell.Row, WorksheetFunction.Match(Left(s, 2), ActiveSheet.Range("A1:H1"), 0))
        If cel.Value <> "" Then cel.Value = cel.Value + vbLf
        cel.Value = cel.Value + s
    Next s
Next vcell
    End Sub

任何人都可以帮助我吗

Answer 1

这段代码对我有用。 On Error Resume Next是您需要的。

Sub NumFormat()

   Dim colNum As Integer
colNum = ActiveSheet.Rows(1).Find(what:="ABC", lookat:=xlWhole).Column
Dim s As Variant
Dim cel As Range
    'insert two columns
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
ActiveSheet.Columns(colNum + 1).Insert
ActiveSheet.Columns(colNum + 1).Insert
ActiveSheet.Columns(colNum + 1).Insert
ActiveSheet.Columns(colNum + 1).Insert
ActiveSheet.Columns(colNum + 1).Insert
' New col headings
ActiveSheet.Cells(1, colNum + 1).Value = "AB"
ActiveSheet.Cells(1, colNum + 2).Value = "CD"
ActiveSheet.Cells(1, colNum + 3).Value = "EF"
ActiveSheet.Cells(1, colNum + 4).Value = "GH"
ActiveSheet.Cells(1, colNum + 5).Value = "IJ"
ActiveSheet.Cells(1, colNum + 6).Value = "KL"
ActiveSheet.Cells(1, colNum + 7).Value = "MN"
    Dim colRange As Range
With ActiveSheet
    Set colRange = .Range(.Cells(2, colNum), .Cells(.Cells(5000, colNum).End(3).Row, colNum))
End With

Dim splitStr() As String

Dim vcell As Range
For Each vcell In colRange
splitStr = Split(vcell.Value, vbLf)

For Each s In splitStr
On Error GoTo endy
    Set cel = Cells(vcell.Row, WorksheetFunction.Match(Left(s, 2), ActiveSheet.Range("A1:H1"), 0))
    If cel.Value <> "" Then cel.Value = cel.Value + vbLf
    cel.Value = cel.Value + s
endy:
    Next s
Next vcell
    End Sub

Answer 2

您正在使用显式选项。

当我们在代码中使用explicit explicit时，我们必须在使用前声明变量。请声明变量s并尝试运行。

请尝试运行以下代码，它在我的系统上正常运行。让我知道结果。

Option Explicit

    Sub NumFormat()

       Dim colNum As Integer
    Dim s As Variant
    Dim cel As Variant

    colNum = ActiveSheet.Rows(1).Find(what:="ABC", lookat:=xlWhole).Column

        'insert two columns
        ActiveSheet.Columns(colNum + 1).Insert
        ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Columns(colNum + 1).Insert
    ' New col headings
    ActiveSheet.Cells(1, colNum + 1).Value = "AB"
    ActiveSheet.Cells(1, colNum + 2).Value = "CD"
    ActiveSheet.Cells(1, colNum + 3).Value = "EF"
    ActiveSheet.Cells(1, colNum + 4).Value = "GH"
    ActiveSheet.Cells(1, colNum + 5).Value = "IJ"
    ActiveSheet.Cells(1, colNum + 6).Value = "KL"
    ActiveSheet.Cells(1, colNum + 7).Value = "MN"
        Dim colRange As Range
    With ActiveSheet
        Set colRange = .Range(.Cells(2, colNum), .Cells(.UsedRange.Rows.Count, colNum))
    End With

    Dim splitStr() As String

Dim vcell As Range
For Each vcell In colRange
    splitStr = Split(vcell.Value, vbLf)
    For Each s In splitStr
        Set cel = ActiveSheet.Cells(vcell.Row, WorksheetFunction.Match(Left(s, 2), ActiveSheet.Range("A1:H1"), 0))
        If cel.Value <> "" Then cel.Value = cel.Value + vbLf
        cel.Value = cel.Value + s
    Next s
Next vcell
    End Sub

Excel宏用于插入列和查找文本以及带标题

2 个答案: