End(xlDown) 单行

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  

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

XlSpecialCellsValue constants   Value

xlErrors                          16 
xlLogical                         4 
xlNumbers                         1 
xlTextValues                      2  

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