0
的数据如下VBA - 要拆分和Excel文件分成多个文件,并将这些文件分割成多张
我需要通过两级
来划分这个数据根据产品代码的第一个字母(C列)将数据分成不同的工作簿A.xlsx,B.xlsx等将包含仅与这些字母有关的数据
根据唯一产品代码将上述工作簿中的数据分成工作表,例如, C.xlsx将具有名为C02,C021的工作表,这些工作表将包含与修正代码有关的数据。
如何将这两个组合在一个VBA代码中?
我有下面的代码将数据分割成产品代码表:
Sub split_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 3
Set ws = Sheets("Sales Data")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:H1"
titlerow = ws.Range(title).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(title).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
但现在我需要所有的表与一个联合启动进入工作簿“ A.xlsx“并且类似于B,C和D.在此需要帮助
您是否可以将内嵌数据描述为文本?没有它,这个问题是没有用的,如果图像不可访问,这会使问题变得毫无意义。 –
发布您尝试过的内容,如果您还没有尝试过任何内容,请立即尝试,然后回复以获取帮助。与期望别人从头开始编写所有代码相比,您更可能获得帮助。 – SJR
@SJR感谢您的建议。做了同样的工作 –