简体   繁体   中英

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. 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?

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. 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:

在此处输入图片说明

It will be consolidated in Sheet2 like this:

在此处输入图片说明

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.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

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