我有一个包含多列数据的Excel文件。我需要从文件中选择一列,并使用单元格中的特定关键字分隔该列的每个单元格中的数据。 每个单元格的关键字相同
现在我要做的是,我想将每个字母与单元格分开并给它们一个如下图所示的标题
答案 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")
中的工作表名称调整为数据所在工作表的实际名称。
然后,上面的代码将插入一个新工作表并按上述帖子中的描述处理/输出数据。