0

我需要在 Excel 工作表中选择一个单元格字段（表格），将所选内容剪掉，然后将其粘贴到新的单独工作表中。在这张工作表中，有上千张桌子彼此下方，我想自动将它们剪下来并将它们粘贴到单独的工作表中。这些表格由内部带有 # 符号的单元格分隔，但我不知道它是否有任何帮助。当我为第一个表录制这个宏时，它运行如下：

Sub Makro1()
Range("A2:AB20").Select
Selection.Cut
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
End Sub

现在我想创建一个遍历整个工作表的循环，动态选择每个表，这些表将由列 A 中的 # 符号分隔并将其粘贴到新工作表中。我不想选择精确的范围 A2:AB20，但我想根据这个 # 符号进行选择。

这是一个屏幕截图 在此处输入图像描述

4

2 回答 2

1

这将使用所有哈希值的索引填充一个数组。这应该为您提供收集适当数据所需的参考点。

Sub FindHashmarksInColumnA()

    Dim c As Range
    Dim indices() As Long
    Dim i As Long
    Dim iMax As Double
    Dim ws As Worksheet

    Set ws = ActiveSheet

    i = 0
    iMax = Application.WorksheetFunction.CountIf(ws.Range("A:A"), "#")
    ReDim indices(1 To iMax)

    For Each c In ws.UsedRange.Columns(1).Cells
        If c.Value = "#" Then
            i = i + 1
            indices(i) = c.Row
        End If
    Next c

    ' For each index,
    ' Count rows in table,
    ' Copy data offset from reference of hashmark,
    ' Paste onto new sheet in appropriate location etc.

End Sub
于 2013-02-25T13:14:22.080 回答
0

试试这个代码。您可能需要根据需要调整前 4 个常量：

Sub CopyToSheets()
    Const cStrSourceSheet As String = "tabulky"
    Const cStrStartAddress As String = "A2"
    Const cStrSheetNamePrefix As String = "Result"
    Const cStrDivider As String = "#"

    Dim rngSource As Range
    Dim lngMaxRow As Long, lngLastDividerRow As Long, lngRowCount As Long
    Dim wsTarget As Worksheet
    Dim lngCounter As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'Delete old worksheets
    Application.DisplayAlerts = False
    For Each wsTarget In Sheets
        If InStr(wsTarget.Name, cStrSheetNamePrefix) Then wsTarget.Delete
    Next
    Application.DisplayAlerts = True

    With Sheets(cStrSourceSheet)
        Set rngSource = .Range(cStrStartAddress)
        lngLastDividerRow = rngSource.Row
        lngMaxRow = .Cells(Rows.Count, 1).End(xlUp).Row
    End With

    Set rngSource = rngSource.Offset(1)
    While rngSource.Row < lngMaxRow
        If rngSource = cStrDivider Then
            lngCounter = lngCounter + 1
            Set wsTarget = Sheets.Add(After:=Sheets(Sheets.Count))
            wsTarget.Name = cStrSheetNamePrefix & " " & lngCounter
            lngRowCount = rngSource.Row - lngLastDividerRow - 1
            rngSource.Offset(-lngRowCount - 1).Resize(lngRowCount).EntireRow.Copy _
                wsTarget.Range("A1").Resize(lngRowCount).EntireRow

            lngLastDividerRow = rngSource.Row
        End If
        Set rngSource = rngSource.Offset(1)
    Wend

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub
于 2013-02-25T13:31:59.360 回答