简体   繁体   English

VBA Excel-如何识别某些类型的数据

[英]VBA Excel - How to recognize certain types of data

I'm trying to build a macro that will move a table (group of cells) for me to another area of the excel spreadsheet. 我正在尝试建立一个宏,该宏将为我移动一个表(单元格组)到excel电子表格的另一个区域。 I've currently built this (this is the relevant part of code), but it only works with one table, as I coded it based on location of the first table. 我目前已经构建了它(这是代码的相关部分),但是它仅适用于一个表,因为我根据第一个表的位置对其进行了编码。 However, some of my spreadsheets have more tables, of differing locations (all the tables are stacked on top of each other, but have differing heights -- so I can't easily do what I've already done for the first table). 但是,我的某些电子表格具有更多的表格,并且位置不同(所有表格都堆叠在一起,但是高度不同-所以我不容易做我为第一个表格所做的事情)。

So my question is -- is there a way to code VBA to recognize the top left corner of each table (the data in the top left corner is always the same with each table) and then detect when the table (data) end both to the right and bottom of that top left corner, and then move all that? 所以我的问题是-有没有一种方法可以对VBA进行编码,以识别每个表的左上角(每个表的左上角的数据始终相同),然后检测表(数据)何时都结束于那个左上角的右边和底部,然后移动所有这些?

I'm very new to this, and honestly am proud of my shabby "coding" below. 我对此很陌生,并为我下面的破旧“编码”感到自豪。 Any help would be appreciated. 任何帮助,将不胜感激。 I thought about using an "If..Then" statement for the detecting of the top left corner but have no idea how to go from there. 我考虑过要使用“ If..Then”语句来检测左上角,但不知道如何从那里去。 Thank you for any help. 感谢您的任何帮助。

' Moving data and headers
Worksheets("Inventory").Range("E6:E14").Cut Worksheets("Inventory").Range("A1:A9")
Worksheets("Inventory").Range("F6:F14").Cut Worksheets("Inventory").Range("B1:B9")
Worksheets("Inventory").Range("G6:G14").Cut Worksheets("Inventory").Range("C1:C9")
Worksheets("Inventory").Range("H8:H14").Cut Worksheets("Inventory").Range("D3:D9")
Worksheets("Inventory").Range("I8:I14").Cut Worksheets("Inventory").Range("E3:E9")
Worksheets("Inventory").Range("J8:J14").Cut Worksheets("Inventory").Range("F3:F9")
Worksheets("Inventory").Range("K8:K14").Cut Worksheets("Inventory").Range("G3:G9")
Worksheets("Inventory").Range("L8:L14").Cut Worksheets("Inventory").Range("H3:H9")
Worksheets("Inventory").Range("M8:M14").Cut Worksheets("Inventory").Range("I3:I9")
' Merging and putting in Days Worked
Range("D1:I1").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Selection.Merge

Sample Table: 样品表:

样品

If you have a rectangular range, then to find its upper left-hand corner and lower right-hand corner: 如果您有一个矩形范围,那么要找到其左上角和右下角:

Sub CornerFinder(RR As Range)
    Dim addy1 As String, addy2 As String
    addy1 = RR(1).Address(0, 0)

    Dim nLastRow As Long, nLastColumn As Long
    nLastRow = RR.Rows.Count + RR.Row - 1
    nLastColumn = RR.Columns.Count + RR.Column - 1
    addy2 = Cells(nLastRow, nLastColumn).Address(0, 0)

    MsgBox addy1 & vbCrLf & addy2
End Sub

Tested with: 经过测试:

Sub MAIN()
    Dim r As Range
    Set r = Range("B9:J37")
    Call CornerFinder(r)
End Sub

Ok based on your sample data and sample code, try this out. 好吧,根据您的示例数据和示例代码,尝试一下。

Sub Test()
    Const tlh As String = "Credited in Report"
    With Sheets("Sheet1") 'Change to suit
        Dim tl As Range, bl As Range
        Dim first_add As String, tbl_loc As Variant
        Set tl = .Cells.Find(tlh)
        If Not tl Is Nothing Then
            first_add = tl.Address
        Else
            MsgBox "Table does not exist.": Exit Sub
        End If
        Do
            If Not IsArray(tbl_loc) Then
                tbl_loc = Array(tl.Address)
            Else
                ReDim Preserve tbl_loc(UBound(tbl_loc) + 1)
                tbl_loc(UBound(tbl_loc)) = tl.Address
            End If
            Set tl = .Cells.FindNext(tl)
        Loop While tl.Address <> first_add
        Dim i As Long, lrow As Long, tb_cnt As Long: tb_cnt = 0
        For i = LBound(tbl_loc) To UBound(tbl_loc)
            Set bl = .Cells.Find(vbNullString, .Range(tbl_loc(i)) _
                , , , xlByColumns, xlNext)
            lrow = Sheets("Sheet2").Range("A" & _
                   Sheets("Sheet2").Rows.Count).End(xlUp).Row
            .Range(.Range(tbl_loc(i)).Offset(IIf(tb_cnt <> 0, 1, 0), 0), _
                bl.Offset(-1, 0)).Resize(, 9).Copy _
                Sheets("Sheet2").Range("A" & lrow).Offset(IIf(lrow = 1, 0, 1), 0)
            tb_cnt = tb_cnt + 1
            Set bl = Nothing
        Next
    End With
End Sub

This consolidates the data in one table. 这会将数据合并到一个表中。
I used copy instead of cut to be safe. 为了安全起见,我使用副本而不是剪切。 You can change it whatever suits you. 您可以根据自己的需要进行更改。
I also use another sheet for the output since I'm using copy. 由于我使用的是复印件,因此我还将另一张纸用于输出。

For example you have below in Sheet1: 例如,您在Sheet1中具有以下内容:

在此处输入图片说明

It will be consolidated in Sheet2 like this: 它将像这样在Sheet2中合并:

在此处输入图片说明

Is this what you're trying? 这是您要尝试的吗? If not, you can go ahead and learn from the code. 如果没有,您可以继续学习代码。
Then once you do, adjust it to suit your needs. 然后,一旦完成,请对其进行调整以适合您的需求。 :-) HTH. :-) HTH。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM