将逗号分隔的条目拆分为新行,并在列B中使用第二个值

时间:2013-11-26 14:23:32

标签: excel vba excel-vba

我正在尝试将A列中具有多个单元格值的工作表分隔为逗号,并在B列中分隔它的价格。我发现宏用于拆分A列中的多个单元格,但不确定如何添加与列A值相关联的列B值。

我希望将新值复制到C&列中。 D所以我可以检查它是否正常工作。

任何帮助都会非常感激,因为手动操作很多细胞。

(Cell A1) 33
(Cell A2) 333, 334, 3389, 3398, 33876                    
(Cell A3) 44, 447, 44797, 44819
(Cell A4) 52, 5255, 5237, 523700

(Cell B1) 0.0053
(Cell B2) 0.0124
(Cell B3) 0.0089
(Cell B4) 0.0156

2 个答案:

答案 0 :(得分:1)

如果将ColumnA复制到ColumnC,然后将Text to Columns应用于ColumnC,并将,作为分隔符,则结果将类似。

根据特殊要求,通过录制宏:

   Sub Macro1()
'
' Macro1 Macro
'

'
    Columns("A:A").Select
    Selection.Copy
    Range("C1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5,1)), TrailingMinusNumbers:=True
  End Sub  

或缩写版

Sub Macro2()
    Dim rng1 As Range
    Dim rng2 As Range
    Set rng1 = [A:A]
    Set rng2 = [C:C]
    rng1.Copy rng2
    rng2.Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
        Comma:=True, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5,1))
End Sub

答案 1 :(得分:0)

尝试一下:

Sub dural()
    Dim N As Long, K As Long, J As Long, I As Long
    J = 1
    N = Cells(Rows.Count, "A").End(xlUp).Row
    For K = 1 To N
        ary = Split(Cells(K, 1).Value, ",")
        v = Cells(K, 2).Value
        For I = LBound(ary) To UBound(ary)
            Cells(J, 3).Value = ary(I)
            Cells(J, 4) = v
            J = J + 1
        Next I
    Next K
End Sub