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

Question

我正在尝试构建一个宏，为我将 table（单元格组）移动到 excel 电子表格的另一个区域。我目前已经构建了这个（这是代码的相关部分），但它只适用于一个 table，因为我根据第一个 table 的位置对其进行编码。然而，我的一些电子表格有更多 tables，位置不同（所有 tables 都堆叠在一起，但高度不同——所以我不能轻易地做我想做的事第一个已经完成 table)。

所以我的问题是——有没有一种方法可以对 VBA 进行编码以识别每个 table 的左上角（左上角的数据始终与每个 table) 然后检测 table （数据）何时结束到左上角的右侧和底部，然后移动所有这些？

我对此很陌生，老实说，我为下面的破旧 "coding" 感到自豪。任何帮助，将不胜感激。我考虑过使用 "If..Then" 语句来检测左上角，但不知道如何从那里开始。感谢您的帮助。

' 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

样本Table:

Answer 1

如果你有一个矩形范围，然后找到它的左上角和右下角：

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

测试：

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

Answer 2

好的，根据您的示例数据和示例代码，尝试一下。

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

这将数据合并为一个 table。
为了安全起见，我使用了复制而不是剪切。您可以根据自己的喜好进行更改。
我还使用另一个 sheet 作为输出，因为我使用的是 copy.

例如，您在 Sheet1 中有以下内容：

它将像这样合并到 Sheet2 中：

这是您要尝试的吗？如果没有，您可以继续学习代码。
然后一旦你这样做，调整它以满足你的需要。 :-) HTH.

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

VBA Excel - How to recognize certain types of data

excel

vba