Excel VBA:转置字符串的不同部分

Question

我的值水平位于彼此相邻的单元格中。在每个单元格中，我正在提取单元格的某个子字符串，并希望在某些列中垂直转置每个部分。

例：

    ColA                         ColB                       ColC
First.Second<Third>     Fourth.Fifth<Sixth>           Seventh.Eighth<Ninth>

应类似于新工作表 （ws2）：

    ColA          ColB      ColC
    First        Second     Third
    Fourth       Fifth      Sixth
    Seventh      Eighth     Ninth

我尝试遍历行和列，但随机跳过

For i = 2 to lastRow
   lastCol = ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column
       For j = 2 to lastCol
           cellVal = ws.Cells(i, j).Value
            firstVal = Split(cellVal, ".")
            secondVal = 'extract second val
            thirdVal = 'extract third val
             ws2.Cells(i,1).Value = firstVal
             ws2.Cells(i,2).Value = secondVal
             ws3.Cells(i,4).Value = thirdVal

编辑：更新了以下几乎有效的代码：

Sub transPose()
  Dim used As Range
  Set used = Sheet1.UsedRange   'make better constraint if necessary
  Dim cell As Range
  Dim arr(0 To 3) As String
  Dim str As String
  Dim pointStr As Variant, arrowSplit As Variant
  Dim rowCount As Long
  rowCount = 0
  For Each cell In used      'This goes across rows and then down columns
        str = Trim(cell.Value2)
        If str <> "" Then    'Use better qualification if necessary
              spaceStr = Split(str, " ")
              arr(0) = spaceStr(0)
              arr(1) = spaceStr(1)
              arrowSplit = Split(spaceStr(1), "<")
              arr(2) = LCase(Mid(str, Application.Find("<", str) + 1, 1)) & LCase(arrowSplit(0))
              openEmail = InStr(str, "<")
              closeEmail = InStr(str, ">")
              arr(3) = Mid(str, openEmail + 1, closeEmail - openEmail - 1)
              rowCount = rowCount + 1
              Sheet2.Cells(1 + rowCount, 1).Resize(1, 4).Value = arr
        End If
  Next cell
End Sub

编辑2：数据实际上看起来像

           ColA                                  ColB                    etc...
  John Smith<[e-mail]>         Jane Doe<[e-mail]>

并且应该看起来像：

ColA     ColB      ColC           ColD
John     Smith    jsmith     [e-mail]
Jane     Doe      jdoe       [e-mail]

Answer 1

试试这个：

Sub transPose()
  Dim used As Range
  Set used = Sheet1.UsedRange   'make better constraint if necessary
  Dim cell As Range
  Dim arr(0 To 2) As String
  Dim str As String
  Dim pointStr As Variant, arrowSplit As Variant
  Dim rowCount As Long
  rowCount = 0
  For Each cell In used      'This goes across rows and then down columns
        str = cell.Value2
        If str <> "" Then    'Use better qualification if necessary
              pointStr = Split(str, ".")
              arr(0) = pointStr(0)
              arrowSplit = Split(pointStr(1), "<")
              arr(1) = arrowSplit(0)
              arr(2) = Split(arrowSplit(1), ">")(0)
              rowCount = rowCount + 1
              Sheet2.Cells(1 + rowCount, 1).Resize(1, 3).Value = arr
        End If
  Next cell
End Sub

Answer 2

对于每个输入行，您将有 3 个输出行，这意味着您将每个输入行的输出行递增 3。此外，单元格函数采用（行、列）参数。

如果您将 i 和 j 从起始行/col 迭代到最后一行/col，数学就会变得愚蠢，所以我建议改为迭代行/列的计数并使用起点作为参考，无论是存储为 Range 对象的单元格还是起始行/列。

For i = 0 to ws.Rows.Count
   For j = 0 to ws.Columns.Count
           cellVal = ws.Cells(i + startRow, j + startCol).Value
            firstVal = Split(cellVal, ".")
            secondVal = 'extract second val
            thirdVal = 'extract third val
             ws2.Cells((i*3) + startRow, j + startCol).Value = firstVal
             ws2.Cells((i*3) + 1 + startRow, j + startCol).Value = secondVal
             ws3.Cells((i*3) + 2 + startRow, j + startCol).Value = thirdVal

等。。。

事实上，如果我这样做，我可能只会制作函数的inputRange和outputRange参数，然后迭代这些参数。它将简化迭代（不需要混乱的startRow或startCol）和索引。如果您正在寻找这种解决方案，请发表评论，我可以添加它。

Answer 3

在

OP编辑的问题之后编辑

你可以试试这个：

Sub main2()
    Dim cell As Range, row As Range
    Dim arr As Variant
    Dim finalValues(1 To 4) As String
    Dim iRow As Long
    Dim ws As Worksheet, ws2 As Worksheet
    Set ws = Worksheets("originalData") '<--| change "originalData" to your actual sheet name with starting data
    Set ws2 = Worksheets("results") '<--| change "results" to your actual sheet name with starting data
    For Each row In ws.UsedRange.Rows
        For Each cell In row.SpecialCells(xlCellTypeConstants)
            arr = Split(Replace(Replace(cell.Value, "<", " "), ">", ""), " ")
            finalValues(1) = arr(0): finalValues(2) = arr(1): finalValues(3) = Left(arr(0), 1) & arr(1): finalValues(4) = arr(2)
            iRow = iRow + 1
            ws2.Cells(iRow, 1).Resize(, UBound(finalValues)).Value = finalValues
        Next
    Next
End Sub