將逗號分隔的條目拆分爲列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