0

我正在经营一家卖零食的商店。一共有50个零食品牌（A品牌、B品牌、C品牌……），我必须向50个不同品牌的供应商提交每周销售报告。

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

由于每个品牌的总销售额是信心，我必须根据其品牌将交易分成50个不同的文件并单独提交。手动执行此操作需要时间，因此我正在考虑使用 VBA 代码。

我想，我会做以下

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

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

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

在此处输入图像描述

4

1 回答 1

0

我本质上是在倾销我已经在这里供您使用的预先存在的代码。由于这超出了您的问题应得的范围（鉴于您没有代码可在代码帮助站点上共享），因此我不会对此进行任何编辑。

我会把它留给你 - 试着理解代码在做什么，并在需要时改变它以适应你的需要

宏……

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

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

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

我在一年前写了这个并且使用它没有任何问题，尽管再次查看代码，我可以发现可以进行的更新。

于 2019-02-18T18:08:47.847 回答