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

我有一个Excel工作表，其中包含以下内容：

我曾经在VBA代码上做了如下工作： –

1. find具有标题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.find具有标题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