vba - Excel VBA插入列和拆分单元格内容

Question

我有一个包含以下内容的 Excel 工作表:

我研究过执行以下操作的 VBA 代码:-

1. 找到标题为 ABC
的列
2. 在 ABC 旁边插入两个新列，名称分别为 AAA 和 BBB
3. 然后将ABC单元格内容拆分为AAA和BBB单元格；注意(ABC 列在某些情况下可能只有一行)
4. 执行第 (3) 步，直到 ABC 列内容结束。

最终结果应该是这样的:

我写了以下代码:-

Sub Num()
Dim rngDHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row; adjust as needed.
Set rngDHeader = rngHeaders.Find("ABC")

Sub sbInsertingColumns()
'Inserting a Column at Column B
rngDHeader.EntireColumn.Insert
'Inserting 2 Columns from C
rngDHeader.EntireColumn.Insert
 Dim rngDHeader As Range
   Dim sText As String
   Dim aText As Variant 'array
   Dim i As Long        'number of array elements

   Set rngDHeader = Sheets("Sheet1").Range("C2")

   Do Until rng = ""

      'split the text on carriage return character chr(10)
      aText = Split(rngDHeader.Value, Chr(10))

      'get the number of array elements
      i = UBound(aText)

      'build the output text string
      sText = aText(i - 2) & Chr(10) _
              & aText(i - 1) & Chr(10) _
              & aText(i)

      'output
      rngDHeader.Offset(, 1) = sText

      Set rngDHeader = rngDHeader.Offset(1, 0)
   Loop

   Set rngDHeader = Nothing

End Sub

谁能帮我解决这个问题？

Answer 1

根据您的问题编号:

1.找到标题为ABC的列

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

2.在 ABC 旁边插入两个新列，名称分别为 AAA 和 BBB

' Done twice to insert 2 new cols
ActiveSheet.Columns(colNum + 1).Insert    
ActiveSheet.Columns(colNum + 1).Insert

' New col headings
ActiveSheet.Cells(1, colNum + 1).Value = "AAA"
ActiveSheet.Cells(1, colNum + 2).Value = "BBB"

3.然后将ABC单元格内容拆分为各自的AAA和BBB；注意(ABC 栏在某些情况下可能只有一行)

和

4.按照流程进行，直到ABC列内容结束。

' Define the range to iterate over as the used range of the found column
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

    ' Create an array by splitting on the line break
    splitStr = Split(vcell.value, Chr(10))    

    ' Assign first new column as first array value.
    ActiveSheet.Cells(vcell.row, colNum + 1).Value = splitStr(0)

    ' Assign second new column as second array value. 
    ' First test if there *is* a second array value
    If UBound(splitStr) > 0 Then
        ActiveSheet.Cells(vcell.row, colNum + 2).Value = splitStr(1)        
    End If  

Next vcell