Question

我需要在工作表中获取字符串列表并将其转换为新工作表中的列表，工作表1中的字符串如下所示：

B87YTDF,ENG,22;B54TRDX,ITA,23
B99REDT,FRA,25;B46TEST,GER,29;B94FRDE,GBT,21

我需要在表2中获得的是：

B87YTDF   ENG   22
B54TRDX   ITA   23
B99REDT   FRA   25
B46TEST   GER   29
B94FRDE   GBT   21

所以我需要做的是，对于每个字符串（都在同一列中）：

从工作表1复制字符串并粘贴到工作表2的第一行
执行txt到列分隔;
复制整行，将其粘贴在其下一行并转置
txt到列分隔，
清除仍包含完整字符串的第一行

并对Sheet 1中的所有非空行重复此操作，每次在Sheet 2的第一个自由行中复制并粘贴字符串。

此时我仍然坚持这一点，但不知道如何为Sheet 1中的每一行循环它，并在Sheet 2中的每个第一个自由行中完成它。

Rows("1:1").Select

Selection.Copy

Sheets("Sheet5").Select

ActiveSheet.Paste

Application.CutCopyMode = False

Range("A1").Select

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :=";", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
    1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
    , 1)), TrailingMinusNumbers:=True

Rows("1:1").Select

Selection.Copy

Range("A2").Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

Rows("1:1").Select

Application.CutCopyMode = False

Selection.Delete Shift:=xlUp

感谢您的帮助！

Answer 1

无循环代码：

Option Explicit

Sub main()
    Dim vals As Variant

    With Worksheets("Sheet1")
        vals = Split(Join(Application.Transpose(.Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Value), ";"), ";")
    End With
    With Worksheets("Sheet2").Range("A1").Resize(UBound(vals))
        .Value = Application.Transpose(vals)
        .TextToColumns comma:=True
    End With
End Sub

Answer 2

下面的代码假定您将这些转录存储在A的{{1}}列中，并将解析后的值粘贴到以Sheet1单元格开头的Sheet2中。

试试这段代码：

A1

Answer 3

Sub test()

Dim S 
Dim vS, v, vR(),mys,Myv
Dim n as Long, i as Long


S = Sheet1.range ("a1").currentregion
'vS = Split(S,Char(10))

For each v in S
   Myv = Split (v,";")
   For each mys in Myv
      n= n+1
      Redim preserve vR (1 to 3,1 to n)
      For i= 0 to 2
        vR (i+1,n) = Split (mys,",")(i)
      Next i
    Next mys
Next v

Sheet2.range ("a1").resize (n,3)= application.Transpose (vR)

End sub

列中的每一行和复制/粘贴都会导致另一列中的第一个空闲单元格

3 个答案: