将逗号分隔的条目拆分为列B中的第二个值的新行

Question

我想分隔一个工作表，其中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 

Answer 1

试试这个：

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 

Answer 2

结果是相似的，如果ColumnA被复制到ColumnC然后文本应用到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