使用特定关键字在excel文件列中拆分语句

时间:2016-08-29 09:59:11

标签: excel-vba vba excel

我有一个包含多列数据的Excel文件。我需要从文件中选择一列,并使用单元格中的特定关键字分隔该列的每个单元格中的数据。 每个单元格的关键字相同

enter image description here

现在我要做的是,我想将每个字母与单元格分开并给它们一个如下图所示的标题

enter image description here

1 个答案:

答案 0 :(得分:0)

以下VBA代码应该可以解决这个问题:

Option Explicit

Public Sub MainSub()

Dim arr As Variant
Dim srcRow As Long, destRow As Long
Dim wsSrc As Worksheet, wsDest As Worksheet

Set wsSrc = ThisWorkbook.Worksheets("Sheet1")
Set wsDest = ThisWorkbook.Worksheets.Add(Before:=wsSrc)

wsDest.Cells(1, 1).Value2 = "Letter"
wsDest.Cells(1, 2).Value2 = "Value"
destRow = 2

For srcRow = 1 To wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row
    If InStr(1, wsSrc.Cells(srcRow, 1).Value2, "half:", vbTextCompare) Then
        arr = Split(wsSrc.Cells(srcRow, 1).Value2, "half:")(0)
        arr = Split(arr, "/")
        destRow = WriteToDest(arr, "FULL", destRow, wsDest)
        arr = Split(wsSrc.Cells(srcRow, 1).Value2, "half:")(1)
        arr = Split(arr, "/")
        destRow = WriteToDest(arr, "HALF", destRow, wsDest)
    Else
        arr = Split(wsSrc.Cells(srcRow, 1).Value2, "/")
        destRow = WriteToDest(arr, "FULL", destRow, wsDest)
    End If
Next srcRow

End Sub

Private Function WriteToDest(arr As Variant, HalfOrFull As String, destRow As Long, wsDest As Worksheet) As Long

Dim element As Long

For element = LBound(arr) To UBound(arr)
    If Trim(arr(element)) <> vbNullString Then
        wsDest.Cells(destRow, 1).Value2 = UCase(Trim(arr(element)))
        wsDest.Cells(destRow, 2).Value2 = "FULL"
        destRow = destRow + 1
    End If
Next element

WriteToDest = destRow

End Function

只需将其全部复制到空模块中,然后将Set wsSrc = ThisWorkbook.Worksheets("Sheet1")中的工作表名称调整为数据所在工作表的实际名称。

然后,上面的代码将插入一个新工作表并按上述帖子中的描述处理/输出数据。