☰

将数据从一张工作表的单元格复制到另一张工作表中的多个单元格

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 vba database
将数据从一张工作表的单元格复制到另一张工作表中的多个单元格

我有这个数据库来存储销售数据。我可以通过筛选找到特定的销售数据。我希望有一个按钮，可以在另一张表中将销售数据重新生成为“收据”。

这是我的代码，它在一定程度上起作用：

Dim i As Long
Dim col As Integer
Dim DB_Sheet, Rec_Sheet As Object

Set DB_Sheet = ThisWorkbook.Worksheets("Sheet3")
Set Rec_Sheet = ThisWorkbook.Worksheets("Sheet2")
col = 1
For i = 2 To DB_Sheet.Range("A" & Rows.Count).End(xlUp).Row
        If DB_Sheet.Rows(i).Hidden = False Then
            Rec_Sheet.Cells(1, col) = DB_Sheet.Cells(i, 7)
            Rec_Sheet.Cells(2, col) = DB_Sheet.Cells(i, 8)
            Rec_Sheet.Cells(3, col) = DB_Sheet.Cells(i, 6)
            Rec_Sheet.Cells(4, col) = DB_Sheet.Cells(i, 9)
            Rec_Sheet.Cells(5, col) = DB_Sheet.Cells(i, 5)
        col = col + 1
        End If
Next i

它从第一张表中提取

BUYER  SELLER  DATE  PRODUCTS  CURRENCY
A      B       123   abc        USD
D      E       456   def        GBP

并将其输出到第二张表上

123           456
A             D
B             E
USD           GBP
abc           def

问题是所有产品都存储在一个单元格中（列E，对应于DB_Sheet.Cells(i, 5)）。我想将产品分别粘贴在第二张表的不同行中，如下所示

123           456
A             D
B             E
USD           GBP
a             d
b             e
c             f

我手动记录了这个过程，如下所示：

Range("E2").Select
Selection.TextToColumns Destination:=Range("S2"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, 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)), TrailingMinusNumbers:=True
Range("S2:AB2").Select
Selection.Copy
Range("S3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("S2:AB2").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

我需要帮助将此或任何可实现相同结果的内容添加到我的第一个代码中。

答案1

忽略录制的宏并从头开始构建修改要简单得多。

从您录制的宏来看，您的产品是用逗号分隔的，即使您的示例数据显示并非如此。

因此，假设情况确实如此，以下是修改后的代码，用于将产品“拆分”到单独的行：

'v0.1.0
Dim i As Long
Dim col As Integer
Dim DB_Sheet, Rec_Sheet As Object

Set DB_Sheet = ThisWorkbook.Worksheets("Sheet3")
Set Rec_Sheet = ThisWorkbook.Worksheets("Sheet2")
col = 1
For i = 2 To DB_Sheet.Range("A" & Rows.Count).End(xlUp).Row
    If DB_Sheet.Rows(i).Hidden = False Then
        Rec_Sheet.Cells(1, col) = DB_Sheet.Cells(i, 7)
        Rec_Sheet.Cells(2, col) = DB_Sheet.Cells(i, 8)
        Rec_Sheet.Cells(3, col) = DB_Sheet.Cells(i, 6)
        Rec_Sheet.Cells(4, col) = DB_Sheet.Cells(i, 9)
        Dim varProducts As Variant
        varProducts = Split(DB_Sheet.Cells(i, 5).Value2, ",")
        Rec_Sheet.Cells(5, col).Resize(RowSize:=UBound(varProducts) - LBound(varProducts) + 1).Value2 _
        = WorksheetFunction.Transpose(varProducts)
        col = col + 1
    End If
Next i

当然，关键是Split()将逗号分隔的产品字符串转换为产品数组的函数。

然后将该数组输出到适当的范围就很简单了。

请注意，如果需要不同的分隔符，只需更改Split()函数的第二个参数。

相关内容