Question

我正在经营一家小吃店。总共有50个休闲品牌（品牌A，品牌B，品牌C ......），我必须将每周销售报告提交给50个不同的品牌供应商。

首先，我有一个包含日常交易的原始excel文件。（尚未按品牌分类）假设A列为“品牌”，以下各列为品牌详细信息，例如价格和利润。

由于每个品牌的销售总额充满信心，因此我必须根据其品牌将交易分成50个不同的文件，然后分别提交。手动执行需要花费时间，因此我正在考虑使用VBA代码。

我想，我会做以下

创建50个excel文件并根据品牌命名。
在原始文件中，测试每行（品牌）的第一个单元格是否与目标文件的名称匹配。如果是，请复制该单元格，然后复制下一个右两个单元格（利润和价格），然后粘贴到目标文件中。如果否，请跳过该行。
重复此类操作，直到完全传输品牌A的数据
对品牌B，品牌C等进行操作，直到完成50个品牌。

问题在于我是VBA的新手，所以我不知道如何开始。

我需要创建多少个VBA工作簿？
如何为“品牌”单元构造if函数以查看其是否与目标文件匹配。
我可以使用VBA代码一次创建50个excel工作簿吗？
复制单元格时，如何将其粘贴到目标文件的下一个空行？

enter image description here

Answer 1

我实质上是在转储我已经在这里使用的已有代码。由于这是超出您的问题应有的方式（鉴于您没有在代码辅助网站上共享的代码），因此，我不会对此进行任何编辑。

我将留给您-尝试了解代码在做什么，并在需要时根据您的需要进行调整

宏。...

确定由Column A确定的值的唯一列表
为每个唯一值创建一个新表，以使Sheet Name = Unique Value
遍历每个新工作表，按工作表名称（唯一标识符）过滤原始数据，然后将所有过滤的单元格复制/粘贴到各自的工作表中
下一个宏（需要单独调用）将在保存主书的位置创建一个新文件夹，然后开始将每个工作表保存为自己的工作簿。

为每个独特的品牌创建独特的表

Sub parse_data()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant

Dim titlerow As Integer
vcol = 1

lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row

titlerow = ws.Range("A1").Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"

For i = 2 To lr
On Error Resume Next
    If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
        ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
    End If
Next

myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear

For i = 2 To UBound(myarr)
    ws.Range("A1:C" & lr).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit

Next
ws.AutoFilterMode = False
ws.Activate

End Sub

为上面创建的每张图纸创建唯一的书

' New MACRO

Sub SplitWorkbook()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd")
FolderName = xWb.Path & "\" & "Brands" & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
    xWs.Copy
    If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        Select Case xWb.FileFormat
            Case 51:
                FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If Application.ActiveWorkbook.HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56:
                FileExtStr = ".xls": FileFormatNum = 56
            Case Else:
                FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
    End If



    xFile = FolderName & "\" & "Brands" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
    Application.ActiveWorkbook.Close False
Next
MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub

我是一年前写的，使用它没有任何问题，尽管再次查看代码，我仍然可以发现可以进行的更新。

如何使用VBA对数据进行分类并传输到其他文件？

1 个答案:

宏。...

为每个独特的品牌创建独特的表

为上面创建的每张图纸创建唯一的书