Question

我有一个99％的时间都在工作的宏，但是我却遇到了麻烦。我有根据某些参数分为不同大小组的数据。这些组的范围从1行到10+为止。我正在尝试复制每个“组”并将其粘贴到模板表中，然后保存我发现的内容。

 Row  Column B  Column C
1      ASDF      a
2      SDF       a
3      WIRO      a
4      VNDH      a
5 
6      FIJDK     b
7      DFKIEL    b
8 
9      DLFKD     c
10 
11     OYPTK     d
12     SSAODKJ   d
13     SKJSJ     d

我遇到麻烦的是第9行，其中b列B = DLFKD和C列= C

所需的输出： 仅复制第9行

实际输出： 复制第9-11行

现有宏：数据从第5行开始。

Sub templatecopy()
Dim x As Workbook
Dim y As Workbook
Dim N As Long
Dim name As String


'## Open both workbooks first:
Set x = ActiveWorkbook

'Set R
R = 5

'start Loop
Do Until N = 96
Set y = Workbooks.Open("F:\Logistics Dashboard\Customs Macro\Cover Sheet Template.xlsx")

'set N
N = Range("B" & R).Cells(1, 1).End(xlDown).Row

'Now, copy Container Numbers from x and past to y(template):
x.Sheets("Sheet1").Range("B" & R & ":C" & N).Copy
y.Sheets("Sheet1").Range("A14").PasteSpecial

'save as Name of Vessel
name = "F:\Logistics Dashboard\Customs Macro\" & y.Sheets("Sheet1").Range("A14").Value & ".xlsx"
ActiveWorkbook.SaveAs Filename:=name

'Close template after saving to reset:
y.Close



'set R equal to new row to start
R = N + 2


Loop

End Sub

问题在于我如何设置“ N”。它难以区分第9行，其中仅一行数据。

Answer 1

选择正确的工作表后，此行代码应选择工作表上的范围：

Thisworkbook.Worksheets("Sheet1").range("B:C").specialcells(xlcelltypeconstants,23).select

您需要添加另一行来说明公式和常量。

Public Sub FindRegionsOnSheet()

    Dim sAddress As String
    Dim aAddress() As String
    Dim vItem As Variant
    Dim x As Long

    Dim wbTarget As Workbook

    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet

    Set wsSource = ThisWorkbook.Worksheets("Sheet1")

    Set wbTarget = Workbooks.Open("F:\Logistics Dashboard\Customs Macro\Cover Sheet Template.xlsx")
    Set wsTarget = wbTarget.Worksheets("Sheet1")

    'Find all ranges of constant & formula values in column B:C.
    With wsSource.Columns(2).Resize(, 2)
        On Error Resume Next
        sAddress = .SpecialCells(xlCellTypeConstants, 23).Address(0, 0) & ","
        sAddress = sAddress & .SpecialCells(xlCellTypeFormulas, 23).Address(0, 0)
        If Right(sAddress, 1) = "," Then sAddress = Left(sAddress, Len(sAddress) - 1)
        On Error GoTo 0
    End With

    'Place within an array.
    If Not sAddress = vbNullString Then
        If InStr(1, sAddress, ",") = 0 Then
            ReDim aAddress(0 To 0)
            aAddress(0) = "'" & wsSource.Name & "'!" & sAddress
        Else
            aAddress = Split(sAddress, ",")
            For x = LBound(aAddress) To UBound(aAddress)
                aAddress(x) = "'" & wsSource.Name & "'!" & aAddress(x)
            Next x
        End If
    End If

    ''''''''''''''''''''''''''''''''''''''''
    'Not sure how what you're doing once moved to the Target book......
    'Think this is correct, but test first...
    ''''''''''''''''''''''''''''''''''''''''
    For Each vItem In aAddress
        wsTarget.Cells.Clear
        Range(vItem).Copy Destination:=wsTarget.Range("A14")
        wbTarget.SaveCopyAs "F:\Logistics Dashboard\Customs Macro\" & wbTarget.Sheets("Sheet1").Range("A14") & ".xlsx"
    Next vItem

    wbTarget.Close

End Sub

23中的SpecialCells指示要在结果中包括哪些类型的单元格：

XlSpecialCellsValue constants   Value

xlErrors                          16 
xlLogical                         4 
xlNumbers                         1 
xlTextValues                      2

这些值可以加在一起以返回不止一种类型（总计= 23）。默认值是选择所有常量或公式，无论类型是什么。...因此可能根本不需要23。

单行的End（xlDown）

1 个答案: