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

EDIT2：数据实际上看起来像是

           ColA                                  ColB                    etc...
  John Smith<John.Smith@google.com>         Jane Doe<Jane.Doe@google.com>

应该看起来像：

ColA     ColB      ColC           ColD
John     Smith    jsmith     john.smith@google.com
Jane     Doe      jdoe       jane.doe@google.com

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。此外，Cells函数采用（row，col）参数。

如果你从开始行/ col到最后一行/ col迭代i和j，数学变得很愚蠢，所以我建议迭代遍历行/列的计数并使用起始点作为参考，或者a单元格存储为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

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

3 个答案: