文章/答案/技术大牛

发布

社区首页 >问答首页 >基于两个字符之一拆分单元格并向下复制

问基于两个字符之一拆分单元格并向下复制
EN

Stack Overflow用户

提问于 2017-03-14 05:12:23

回答 1查看 38关注 0票数 1

我刚刚被要求拆分一堆看起来像这样的细胞：

之前：

Upld for #: 16 Submit URL 
HY-Upld & Attstn for #: 17 Upload Materials
HY-Attstn, Chklst & Upld for #: 31 Upload Proofs

我看到的唯一模式是有些单元格有‘&’字符，有些单元格有‘，’和‘&’。我正在尝试找出一种基于“&”和“，”字符来解析行的方法。所以，我的“之前”可以转换成我的“之后”。

之后：

Upld for #: 16 Submit URL 
HY-Upld for #: 17 Upload Materials
Attstn for #: 17 Upload Materials
HY-Attstn for #: 31 Upload Proofs
Chklst for #: 31 Upload Proofs
Upld for #: 31 Upload Proofs

所有记录都是ColumnA格式的，这可能会让这件事变得更容易一些。我所能预见的就是拆分单元格，就像我在下面的代码示例中尝试做的那样，并根据“&”和“&”这两个字符向下复制每个拆分。据我所知，问题是我可以拆分一个字符，但不能同时拆分两个字符。

Dim iRow As Long, nRows As Long
Dim arr As Variant
    With Sheets("Forms_Labels")
        For iRow = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
            With .Cells(iRow, 1)
                arr = Split(.Offset(, 0).Value, "&")
                nRows = UBound(arr)
                On Error Resume Next
                .Offset(1).Resize(nRows).EntireRow.Insert xlShiftDown
                .Resize(nRows + 1).Value = .Value
                .Offset(, 1).Resize(nRows + 1).Value = .Application.Transpose(arr)
                .Offset(, 2).Resize(nRows + 1).Value = .Offset(, 1).Value
            End With
        Next
    End With

你知道我怎么才能实现这个概念吗？

vba

excel

回答 1

Stack Overflow用户

回答已采纳

发布于 2017-03-14 05:59:46

这将是我的方法(基于我上面的评论)：

Option Base 0
Option Explicit

Public Sub tmpSO()

Dim arrToDo, arrWhat
Dim strWhat As String
Dim sourceList(), resultList() As String
Dim wsSheet As Worksheet
Dim iRow As Long, nRows As Long

Set wsSheet = Sheets("Forms_Labels")
sourceList = wsSheet.Range("A1:A" & wsSheet.Cells(wsSheet.Rows.Count, 1).End(xlUp).Row).Value2

ReDim resultList(0)
For iRow = LBound(sourceList) To UBound(sourceList)
    arrToDo = Split(sourceList(iRow, 1), "#")
    strWhat = arrToDo(0)
    strWhat = Trim(Replace(strWhat, "for", ""))
    strWhat = Replace(Replace(strWhat, ",", " "), "&", " ")
    While InStr(1, strWhat, "  ")
        strWhat = Replace(strWhat, "  ", " ")
    Wend
    arrWhat = Split(strWhat, " ")
    For nRows = LBound(arrWhat) To UBound(arrWhat)
        resultList(UBound(resultList)) = arrWhat(nRows) & " for #" & arrToDo(1)
        ReDim Preserve resultList(UBound(resultList) + 1)
    Next nRows
Next iRow

wsSheet.Range("A1:A" & UBound(resultList) + 1).Value2 = Application.Transpose(resultList)

End Sub

票数 1

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/42773524

复制

相似问题

问基于两个字符之一拆分单元格并向下复制
EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问基于两个字符之一拆分单元格并向下复制EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问基于两个字符之一拆分单元格并向下复制
EN